perm filename SMLMUS.FAI[TMP,LCS]1 blob
sn#162130 filedate 1975-06-06 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00055 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00006 00002 TITLE MUSIC
00500 C00009 00003 INPUT ROUTINE. CALL INITIALLY WITH PUSHJ P,SETUP
00600 C00012 00004 RIN: ILDB TIB+1 GET FILE NAME
00700 C00014 00005 AER1: MOVEI DEV1MS ERROR ROUTINE FOR NOT AVAILABLE
00800 C00016 00006 SIXOUT: TLO 440600 MAKE BYTE POINTER
00900 C00018 00007 SUBTTL ALGOL SCANNER -- 9/8/66 D. POOLE
01000 C00021 00008 MOVE A,ACCUM PREPARE TO SEARCH TABLES.
01100 C00024 00009 FOOSCH: LDB B,[POINT 6,ACCUM,17]
01200 C00026 00010 SNUM1: MOVEI C,0 NUMBER SCANNER.
01300 C00028 00011 NOW SEARCH NUMBER TABLE FOR THE NUMBER.
01400 C00030 00012 RESERVED WORD TABLE SEARCHER.
01500 C00032 00013 THE CHARACTER CONVERSION TABLE -- GOOD BITS FOR EVERYONE !
01600 C00034 00014 DEFINE PUT1 (N,Y)
01700 C00036 00015 MORE BITS AND PARAMETERS.
01800 C00038 00016 TEMPSY: EXP TMPS1Z
01900 C00043 00017 TMPSA: EXP TMPS4 LINEN.
02000 C00045 00018 HERE ARE SOME WONDERFUL UNIT GENERATORS.
02100 C00054 00019 REVERBERATION UNIT GENERATORS.
02200 C00058 00020 MORE GENERATORS.
02300 C00061 00021 RANDOM NUMBER GENERATORS.
02400 C00064 00022 PLIST: BLOCK LPLIST
02500 C00065 00023 THIS IS THE MULTIPLE-FEEDBACK REVERBERATOR.
02600 C00067 00024
02700 C00069 00025 ***** COMPX BEGINS HERE **** ROUTINES TO EMIT CODE AND STUFF TO OUTPUT BUFFERS.
02800 C00072 00026 THIS HERE IS THE COMPILER !
02900 C00074 00027 PRIM2: CAMN A,MINV UNARY MINUS ?
03000 C00077 00028 PROCESS A FUNCTION CALL.
03100 C00080 00029 HERE ARE THE GLORIOUS, SUPER-INTELLIGENT, SCHIZOPHRENIC
03200 C00083 00030 HA! I BET YOU THOUGHT WE WERE DONE, DIDN'T YOU ?
03300 C00085 00031 GMURK CLEVERLY GPONDERS THE TOP TWO OPERANDS,
03400 C00088 00032 STILL MORE KLUGES. PAUSE TO GET YOUR BREATH NOW.
03500 C00091 00033 GETAC SEARCHES FOR A FREE AC, EITHER I-TIME OR
03600 C00094 00034 MORE GENERATORS.
03700 C00096 00035 GFUNC: GENERATE A FUNCTION CALL.
03800 C00099 00036 UTILITY RUOTINE TO ENTER AN ITEM IN THE MAIN SYMBOL TAB.
03900 C00101 00037 INITIALIZATION OF THE COMPILER.
04000 C00103 00038 SYNTAX ANALYZER.
04100 C00106 00039
04200 C00108 00040 DF5: CAME A,COMMAV ARE THERE MORE DEFINITIONS ?
04300 C00111 00041 DF2A: TLNE A,DF+NUMFLG
04400 C00114 00042 MORE SYNTAX ANALYZER. COMPILE AN INSTRUMENT DEFINITION.
04500 C00117 00043 CINS4: PUSHJ P,STMT1 ITS NOT A UNIT GEN. CALL.
04600 C00121 00044 THE WONDERFUL, WINNING LOADER.
04700 C00124 00045 MORE LOADER (BUT NOT MUCH MORE, YOU WILL NOTICE !).
04800 C00126 00046 DARR: PUSH P,[0] DEFINE SOME ARRAYS.
04900 C00129 00047 HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.
05000 C00132 00048 THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
05100 C00135 00049 MORE OF PINS.
05200 C00138 00050 THIS ROUTINE GENERATES SAMPLES BY CALLING THE
05300 C00141 00051 RANDOM ROUTINES TO HANDLE THE SAMPLE OUTPUT BUFFER.
05400 C00146 00052 ERROR HANDLING(?) ROUTINES.
05500 C00148 00053
05600 C00149 00054 RDNUM: 0 NUMBER READER FOR FOOTRAN ROUTINES.
05700 C00152 00055 REST1: MOVEI TEMPSY
05800 C00154 ENDMK
05900 C⊗;
00100 TITLE MUSIC
00200 ;;;****** AS OF JAN. 12, 1971 *********
00300 ; XGP INIT ADDED JAN 1974
00400 ↓T←1
00500 T1←2
00600 T2←3
00700 T3←4
00800 A←5
00900 B ←6
01000 C←7
01100 D←10
01200 E←11
01300 F←12
01400 H←14
01500 OSP←13
01600 ↓P←15
01700 ↓FL←17
01800 NACS←←5
01900 NFACS←←4
02000 INSXR←←NFACS-1
02100 SSPCF←←10
02200 SDFLG←←20
02300 SNUMF←←40
02400 FIXFLG←←1000
02500 FLTFLG←←2000
02600 DF←←400000
02700 NUMFLG←←FIXFLG+FLTFLG
02800 SSPC2F←←4000
02900
03000 RFLG←←0 ;$$$%%&%$###""##$%$$$$$
03100 DECLBIT←←400
03200 RVBT←←400
03300 PRVBT←←11
03400 MULBIT←←1
03500 ADDBIT←←2
03600 FOOBIT←←100
03700 INSBIT←←40
03800 UGBIT←←4000
03900 FPARBT←←200
04000
04100 SRACBT←←10000
04200 SIACBT←←20000
04300 GPBIT←←FOOBIT ;NOT I OR X.
04400 FUNBIT←←40000
04500 SWVBT←←100000 ;DO NOT CHANGE ! SEE GFUNC.
04600 VRBLBT←←200000
04700 ;; RELOCATION AND FIXUP BITS .
04800 .FXBTS←←1
04900 LFXBTS←←2
05000 VRELBT←←14+1
05100 RRELBT←←4+1
05200 IRELBT←←10+1
05300 ;; FLAGS (RIGHT HALF):
05400 CSBRBT←←1
05500 SFOOBT←←10
05600 USBRBT←←2
05700 GFUNCF←←4
05800 EXTFLG←←40
05900 ARRFLG←←20
06000 RVFLG←←100
06100 RESTART←←200
06200 ;FLAGS (LEFT HALF).
06300 ERRFLG←←1
06400 MINFLG←←2
06500 SNUMF1←←4
06600 NOSTAR←←10
06700 DTFLG←←20
06800 ;; PARAMETER DESCRIPTOR BITS:
06900 FAOPAR←←1
07000 FDPARB←←4
07100 FDPARC←←5
07200
07300 COFF←←1000 ;PI CHANNEL OFF.
07400 CON←←2000
07500 DACHN←←100 ;PI CHANNEL 1.
07600
07700 LRFXBT←←200000 ;LEFT HALF REPLACEMENT FIXUP BIT.
07800 RRFXBT←←100000 ;RIGHT HALF.
07900 SWAPBT←←40000 ;SWAPPED FIXUP.
08000
08100 ;;;;; 5/74 DEFINE IOWD (A,B) <XWD -A,B-1>
08200 OPDEF EXP [0]
08300 OPDEF FIX [XWD 247000,0] ;FOR PDP10 ONLY. REMOVE WITH DDT FOR PDP6
08400 ;*********↑↑↑↑↑↑↑↑↑
08500 OPDEF OUTCHR [XWD 51040,0]
08600 ;;UUOSER: 0
08700 ;; MOVEM A,SAVEA#
08800 ;; HLRZ A,40
08900 ;; CAIL A,2000
09000 ;; JRST FIXER
09100 ;; MOVE A,SAVEA
09200 ;; JSR ERR1
09300 ;; JRSTF @UUOSER
09400
00100 ;INPUT ROUTINE. CALL INITIALLY WITH PUSHJ P,SETUP
00200 ;WILL READIN DTA# AND FILE NAME. GET CHRS BY
00300 ;ILDB IBUF+1. NEXT BUFFER BY INPUT DT,0.
00400 ;;;EXTERNAL IFIX
00500 EXTERNAL SMPLS
00600
00700 TTY←←10
00800 DT←←11
00900 ADCHN←←12
01000 SETUP: CALL [SIXBIT /RESET/]
01100 SETUP1: INIT TTY,1
01200 SIXBIT /TTY/
01300 XWD TOB,TIB
01400 CALL [SIXBIT /EXIT/]; ERROR CONDITION
01500 MOVSI 400000
01600 ANDCAM TIBUF+1 ;MARK INPUT BUFFERS EMPTY.
01700 ANDCAM BUF1+1
01800 ANDCAM BUF2+1
01900 ANDCAM BUF3+1
02000 HRRI TIBUF+1 ;INIT. BUFFER POINTERS.
02100 MOVEM TIB
02200 HRRI TOBUF+1
02300 MOVEM TOB
02400 OUTPUT TTY,1; SEE THE HAPPY SYSTEM
02500 ;;COLGATE OUTPUT TTY,
02600 TRNE FL,RESTART ;ARE WE RESTARTINIG ?
02700 JRST SET4 ;YES.
02800 MOVEI IMS
02900 JSR TXTOUT; A LF/CR *
03000 ;; 5/74 INPUT TTY,0; THE DTA # AND NAME
03100 ;; SETZM DNAM
03200 ;; MOVE 2,[POINT 6,DNAM]
03300 ;; MOVEI T2,6
03400 ;;SET3: ILDB TIB+1
03500 ;; CAIN ":"
03600 ;; JRST SET4
03700 ;; SUBI 40
03800 ;; IDPB 2
03900 ;; SOJG T2,SET3
04000 ;*******↓↓↓↓↓ 5/74
04100 EXTERNAL FILBRK,DLK,ASTR
04200 INTERNAL DEV
04300 SETZM ASTR
04400 JSA 16,FILBRK
04500 MOVE T2,[SIXBIT/TTY/]
04600 SKIPN DLK
04700 MOVEM T2,DNAM
04800 ;******↑↑↑↑↑
04900 SET4: INIT DT,1
05000 DNAM:DEV: SIXBIT /DTA/
05100 XWD 0,IBUF ;NO OUPUT ON THIS DEVICE.
05200 JRST AER1
05300 MOVE [XWD 400000,BUF1+1] ;ET UP BUFFER
05400 MOVEM IBUF ;HEADER SO SYSTEM WILL USE OUR BUFFERS.
05500 MOVSI 700
05600 MOVEM SCP ;BYTE SIZE.
05700 ;; 5/74 SETZM DLK+3 ;TO READ FILES OFF DSK
05800 TRZE FL,RESTART
05900 JRST SETIN
06000 ;**** NEXT 2 ARE FOR SAVER
06100 MOVEI T,1
06200 MOVEM T,RECCT
06300 ;; 5/74 MOVE T1,[POINT 6,DLK]
06400 ;; SETZM DLK
06500 ;; SETZM DLK+1
06600 ;; MOVEI T2,12
06700 JRST SETIN
06800 ;***********↑↑↑↑↑
00100 RIN: ILDB TIB+1; GET FILE NAME
00200 CAIN 15
00300 JRST SETIN
00400 CAIN "."; AN EXTENSION
00500 JRST SETEX
00600 SUBI 40
00700 IDPB T1
00800 SOJG T2,RIN
00900 JRST SETIN
01000 TIB: 0
01100 POINT 7,0,35
01200 0
01300 TOB: 0
01400 POINT 7,0,35
01500 0
01600 TIBUF: 0
01700 XWD 21,.
01800 BLOCK 22
01900 TOBUF: 0
02000 XWD 21,.
02100 BLOCK 22
02200 ;THIS IS NOW IN FILBRK DLK: BLOCK 4
02300 IBUF: XWD 400000,BUF1+1; MAGIC TO KEEP SYSTEM
02400 SCP: POINT 7,0,35; HAPPY
02500 ICCNT: 0 ;BUFFER CHAR. COUNT.
02600 SETEX: TLZ T1,770000
02700 JRST RIN
02800 SETIN: MOVE 0,DLK+3 ;TO SAVE P,PN
02900 LOOKUP DT,DLK; GET FILE SETUP
03000 JRST NER; NON-EX FILE
03100 MOVEM 0,DLK+3 ;PUTS BACK P,PN
03200 PUSHJ P,RDBUF ;GET FIRST BUFFER
03300 MOVE BUF1+3 ;LINE NO. FIRST ?
03400 TRNE 1
03500 AOS SCP ;YES; ADVANCE SCP PAST IT.
03600 SETZM SNCHR
03700 SETZM FOONLY# ;BARF !!
03800 POPJ P,; DONE
03900 BUF1: 0
04000 XWD 201,BUF2+1
04100 BLOCK 202
04200 BUF2: 0
04300 XWD 201,BUF3+1
04400 BLOCK 202
04500 BUF3: 0
04600 XWD 201,BUF1+1
04700 BLOCK 202
04800
00100 AER1: MOVEI DEV1MS; ERROR ROUTINE FOR NOT AVAILABLE
00200 JSR TXTOUT; DECTAPE
00300 MOVEI T1,4
00400 MOVEI DNAM
00500 PUSHJ P,SIXOUT
00600 MOVEI DEV2MS
00700 JSR TXTOUT
00800 JRST SETUP
00900 NER: MOVEI NAM1MS
01000 JSR TXTOUT
01100 MOVEI T1,6
01200 MOVEI DLK
01300 PUSHJ P,SIXOUT
01400 HLRZ DLK+1
01500 JUMPE NEX1
01600 MOVEI "."
01700 IDPB TOB+1
01800 MOVEI T1,3
01900 MOVEI DLK+1
02000 PUSHJ P,SIXOUT
02100 NEX1: MOVEI NAM2MS
02200 JSR TXTOUT
02300 JRST SETUP
02400 NAM1MS: ASCIZ /
02500 FILE /
02600 NAM2MS: ASCIZ / NOT FOUND
02700 /
02800
02900 DECPNT: PUSHJ P,DECPNN ;SPACE COMES AFTER NUM IS TYPED.
03000 MOVEI A,40
03100 SOSGE TOB+2
03200 OUTPUT TTY,0
03300 IDPB A,TOB+1
03400 POPJ P,
03500
03600
03700 DECPNN: IDIVI A,12 ;PRINT DECIMAL INTEGER FROM A.
03800 HRLM B,(P) ;SAVE LOW ORDER DIGIT.
03900 SKIPE A ;DONE ?
04000 PUSHJ P,DECPNN ;NO. RECUR FOR REST OF DIGITS.
04100 HLRZ A,(P) ;YES. GET HIGH ORDER DIGIT.
04200 ADDI A,"0" ;CONVERT TO ASCII.
04300 SOSGE TOB+2 ;OUTPUT IT.
04400 OUTPUT TTY,0
04500 IDPB A,TOB+1
04600 POPJ P, ;RETURN.
00100 SIXOUT: TLO 440600 ; MAKE BYTE POINTER
00200 LOOPTS: SOJL T1,[POPJ P,]
00300 ILDB T,0
00400 JUMPE T,[POPJ P,]
00500 ADDI T,40
00600 IDPB T,TOB+1
00700 JRST LOOPTS
00800 TXTOUT: 0
00900 TLO 440700; ANOTHER POINTER
01000 LPT1: ILDB T,0
01100 JUMPE T,RETPT
01200 SOSGE TOB+2
01300 OUTPUT TTY,0
01400 IDPB T,TOB+1
01500 JRST LPT1
01600 RETPT: OUTPUT TTY,0
01700 JRST @TXTOUT
01800 DEV1MS: ASCIZ /
01900 DEVICE /
02000 DEV2MS: ASCIZ / NOT AVAILABLE
02100 /
02200 IMS: ASCIZ /
02300 * INPUT ? /
02400
02500 RDBUF: MOVEI [BYTE (7)15,12,52] ;ASCIZ / CR LF */
02600 MOVSI A,'TTY'
02700 CAME A,DNAM ;IS INPUT DEVICE A TTY ?
02800 TLO FL,NOSTAR ;NO. SUPRESS THE *.
02900 TLZN FL,NOSTAR ;PRINT IF NOSTAR NOT ON.
03000 CALLI 3 ;YES. TYPE CR LF *.
03100 ;; NEXT 2 FOR SAVER
03200 USETI DT,@RECCT# ;POSITION INPUT FILE TO RIGHT RECORD.
03300 AOS RECCT ;ADD 1 TO RECORD CTR
03400 INPUT DT,0 ;READ NEW INPUT BUFFER.
03500 STATZ DT,20000 ;END OF FILE SEEN ?
03600 JRST SETUP ;YES.
03700 MOVEI 4 ;MAKE SURE 0 WORD TERMINATES IT.
03800 ADD ICCNT ;CHAR. COUNT +4/5 IS WORD COUNT.
03900 MOVEI A,5 ;BECAUSE WE DON'T WANT TO LOSE B.
04000 IDIVM A ;SEE? NO RANDOM REMAINDER !!
04100 ADD A,SCP ;ADD BASE ADDRESS.
04200 IBP A ;BAGBITING SYSTEM.
04300 SETZM (A) ;ZERO IT.
04400 MOVE SCP
04500 MOVEM ISCP# ;SAVE FOR ERROR PRINTOUT.
04600 POPJ P,
00100 SUBTTL ALGOL SCANNER -- 9/8/66 D. POOLE
00200
00300 ;CALL IS PUSHJ P,-----. SCANS NEXT ATOMIC ELEMENT OF
00400 ; INPUT STRING, RETURNS ELEMENT IN ACCUM. 'A' AS FOLLOWS:
00500 ; UNDEFINED IDENTIFIER-- RETURNS 0.
00600 ; DECLARED IDENTIFIER--- 'A' CONTAINS RANDOM GOOD BITS FROM
00700 ; THE SYM. TBL. IN LEFT HALF, PTR. TO RGB WORD IN RT. HALF.
00800 ;RESERVED WORD OR SINGLE-CHARACTER OPERATOR--- 'A' CONTAINS
00900 ; THE RANDOM BITS WORD FROM EITHER THE RESERVED WORD TABLE
01000 ; OR THE CHAR. CONVERT TABLE, RESPECTIVELY.
01100
01200
01300 BUCKNO←←1; SEE DFUNC BEFORE CHANGING !!!!
01400
01500 ACCUM: BLOCK 40 ;GOOD ENOUGH FOR NOW...
01600
01700 SCANNS: TLOA FL,NOSTAR ;SUPRESS PRINTING OF *.
01800
01900 SCANR: TLOA FL,400000 ;ENTRY WHEN EXPECTING OPERATOR OR
02000 ; RESERVED WORD.
02100 SCANV: TLZ FL,400000 ;ENTRY WHEN EXPECTING VARIABLE.
02200
02300 SCAN:
02400 SKIPE A,SNCHR# ;IF SNCHR IS NON-ZERO,
02500 JRST SL1 ; IT IS THE NEXT CHAR. TO SCAN.
02600 SL10: ILDB A,SCP ;GET NEXT CHAR.
02700 SKIPN A,CTBL(A) ;SKIP LEADING BLANKS.
02800 JRST SL10
02900
03000 JUMPL A,SL1A ;IF OPERATOR, WE'RE DONE.
03100 TLNE A,SNUMF ;CHECK FOR PART OF A NUMBER.
03200 JRST SNUM1
03300 MOVE T2,[POINT 6,ACCUM,5] ;PREPARE TO SCAN AN
03400 SETZB T,ACCUM ;IDENTIFIER.
03500 MOVEM T,ACCUM+1
03600 MOVEM A,FOONLY
03700 SL2: IDPB A,T2 ;APPEND CHAR. TO IDENTIFIER.
03800 ILDB A,SCP ;NEXT CHAR.
03900 SKIPLE A,CTBL(A) ;CHECK FOR TERMINATOR.
04000 AOJA T,SL2 ;INCREMENT COUNT AND LOOP.
04100 TLNE A,SSPC2F ;DOES TERMINATING CHAR. REQUIRE
04200 JRST SSPCB ;IMMEDIATE ATTENTION ?
04300 MOVEM A,SNCHR ;NO, SAVE IT FOR NEXT TIME.
04400 ADDI T,1
04500 DPB T,[POINT 6,ACCUM,5] ;PUT COUNT IN FIRST CHAR.
04600 HRRZS T2
04700 SUBI T2,ACCUM
04800 HRRZM T2,ACCWC#
00100 MOVE A,ACCUM ;PREPARE TO SEARCH TABLES.
00200 MOVE C,ACCUM+1
00300 TLZE FL,400000 ;DO WE EXPECT AN OPERATOR ?
00400 JRST SRSCH ;YES; SEARCH RES. WD. TBL. FIRST
00500 SMSCH: MOVE T,A ;SEARCH MAIN SYM. TBL.
00600 IDIVI T,BUCKNO ;DO HASH ON IDENT.
00700 MOVMS T1 ;MAKE SURE IT'S POSITIVE.
00800 MOVEM T1,CBNO# ;SAVE BUCKET NO.
00900 HRRZ B,BUCTBL(T1) ;HEAD OF RIGHT BUCKET
01000 ; IN SYM. TBL.
01100 SL5: CAMN A,1(B) ;COMPARE FIRST WORDS.
01200 JRST SL4
01300 SL6: HRRZ B,(B) ;GET NEXT ELEMENT OF
01400 JRST SL5 ; THE LINKED LIST.
01500 SL4: CAIN B,A-1 ;FIRST WORD WAS EQUAL...
01600 JRST SNO ; WE ARE AT END OF BUCKET.
01700 SKIPN T1,T2
01800 JRST SFOUND ;ONLY 1 WORD; WE'RE DONE.
01900 CAME C,3(B) ;COMPARE SECOND WORDS...
02000 JRST SL6 ;NOPE.
02100 SOJE T1,SFOUND ;ANY MORE WORDS ?
02200 MOVE T3,[XWD B,4]; YES. PREPARE TO CHECK THEM.
02300 SL7: MOVE D,ACCUM-2(T3)
02400 CAME D,@T3
02500 JRST SL6 ;NOT EQUAL.
02600 SOJE T1,SFOUND ;MORE STILL ?
02700 AOJA T3,SL7 ;YES; KEEP CHECKING.
02800
02900 SFOUND: MOVEI A,2(B) ;FOUND HIM; CALC. PTR. TO RGB WORD.
03000 HLL A,(A) ;GET RANDOM GOOD BITS.
03100 HRRZ B,A
03200 SEXIT: CAIG T2,1 ;MORE THAN 2 WORDS OF NAME ?
03300 POPJ P, ;NO.
03400 SETZM ACCUM(T2) ;YES; ZERO OUT ALL THE WORDS OF
03500 SOJA T2,SEXIT ; ACCUM THAT WE USED.
03600
03700 SNO: TLCN FL,400000 ;NOT IN MAIN TBL; HAVE WE ALREADY
03800 JRST SRSCH ; SEARCHED RES. WORD TBL ?
03900 SN1: MOVE A,FOONLY ;GARPBAZ !
04000 TLNE A,FOOBIT
04100 JRST FOOSCH
04200 SCH1: SETZB A,B ;YES. RETURN 'UNDEFINED'.
04300 POPJ P,
04400
04500 SL1: SETZM SNCHR ;RETURN FOR A SPECIAL CHAR.
04600 SL1A: TLNN A,SSPCF+SSPC2F ;DOES IT NEED SPECIAL SERVICE ?
04700 POPJ P, ;NO.
04800 PUSHJ P,(A) ;YES. DISPATCH ON IT.
04900 JRST SL10 ;CONTINUE SCANNING.
00100 FOOSCH: LDB B,[POINT 6,ACCUM,17]
00200 TRNE FL,SFOOBT ;ARE WE DEFINING A FUNCTION ?
00300 JRST SCH1 ;YES. NO FOO-SYMBOLS ALLOWED.
00400 CAIG B,31 ;IS IT A DIGIT?
00500 CAIGE B,20
00600 JRST SCH1 ;NO.
00700 SUBI B,20 ; TO VALUE.
00800 LDB C,[POINT 6,ACCUM,23]
00900 JUMPE C,FSCH1
01000 LDB D,[POINT 6,ACCUM,29]
01100 JUMPN D,SCH1
01200 IMULI B,12 ;MUL. TENS DIGIT BY 10.
01300 CAIG C,31
01400 CAIGE C,20
01500 JRST SCH1
01600 ADDI B,-20(C) ;ADD IN ONE'S DIGIT.
01700 FSCH1: DPB B,[POINT 17,A,35] ;PUT NUMBER IN A.
01800 POPJ P, ;RETURN FROM SCAN.
01900
02000
02100 S.VT: ;HERE ON VERTICAL TAB.
02200 S.FF: ;FORM FEED.
02300 S.LF: ;LINE FEED
02400 SENDL: TLZ FL,ERRFLG ;END OF LINE. CLEAR ERROR FLAG.
02500 MOVEI A,1
02600 ADD A,SCP ;GET PTR TO NEXT WORD.
02700 SKIPN T,(A)
02800 JRST S.EOB ;ZERO WORD MEANS END OF BUFFER.
02900 TRNN T,1 ;IS IT A LINE NO. ?
03000 POPJ P, ;NO; CONTINUE SCANNING.
03100 TLZ A,770000 ;YES; ADVANCE PTR. PAST IT.
03200 MOVEM A,SCP
03300 POPJ P,
03400 S.EOB: PUSHJ P,RDBUF ;REFILL BUFFER.
03500 JRST SENDL
03600
03700 SSPCB: HALT
03800
03900 SSPCC: HALT
04000
04100 S.LT: ILDB A,SCP ;'<' SEEN; SKIP TO END OF LINE.
04200 CAIE A,12 ;A LINE FEED ?
04300 JRST S.LT ;NO.
04400 JRST SENDL
00100 SNUM1: MOVEI C,0 ;NUMBER SCANNER.
00200 CAMN A,DOTV ;FIRST THING A DECIMAL PT.?
00300 JRST SNUM6 ;YES
00400 MOVNI T,100 ;NO DEC PT. YET.
00500 SNUM2: IMULI C,12
00600 ADDI C,-20(A) ;CONVERT NEW DIGIT TO VALUE AND ADD IN
00700 AOSA T ;INCREMENT DEC. PLACE COUNT.
00800 SNUM6: MOVEI T,0 ;START COUNTING DEC. PLACES.
00900 ILDB A,SCP ;NEXT CHAR.
01000 SKIPG A,CTBL(A) ;GET MAGIC BITS.
01100 JRST SNUM7 ;IT'S A DELIMITER.
01200 TLNE A,SDFLG ;IS IT A DIGIT ?
01300 JRST SNUM2 ;YES.
01400 CAMN A,DOTV ;A DEC. PT. ?
01500 JRST SNUM6 ;YES.
01600 JRST SNUMX1
01700 SNUM7: TLNE A,SSPC2F ;DOES DELIM. REQUIRE INSTANT SERVICE ?
01800 JRST SSPCC ;YES.
01900 MOVEM A,SNCHR ;SAVE FOR NEXT TIME.
02000 SFLTIT: IDIVI C,400000 ;FLOAT IT.
02100 SKIPE C
02200 TLC C,254000
02300 TLC D,233000
02400 FAD C,D
02500 SKIPLE T
02600 FDVR C,[10.0] ;DIVIDE BY 10 ENOUGH TO GET
02700 SOJG T,.-1 ;DEC. PT. IN RIGHT PLACE.
02800 SKIPA T,[XWD FLTFLG,0] ;GET FLOATING PT. FLAG.
02900 SNFX: MOVSI T,FIXFLG
03000 HLLZ A,T ;COPY FLAG TO A.
03100 TRNN FL,SFOOBT
03200 TLZE FL,SNUMF1
03300 POPJ P,
00100 ;; NOW SEARCH NUMBER TABLE FOR THE NUMBER.
00200
00300 TDOA A,NUMBUC ;NUMBUC TO RT. HALF.
00400 SNUM4: HRR A,-1(A) ;GET NEXT LINK.
00500 CAME C,(A) ;IS IT EQUAL ?
00600 JRST .-2 ;NO.
00700 TRNN A,777760 ;ARE WE AT END OF TABLE ?
00800 JRST SNUMNO ;YES.
00900 TDNN T,-1(A) ;NO. DO TYPES MATCH ?
01000 JRST SNUM4 ;NO.
01100 POPJ P, ;YUP. WE'VE FOUND IT.
01200
01300 SNUMNO: TRNE FL,CSBRBT ;ARE WE INSIDE A FUNCTION DEFINITION ?
01400 JRST SNUMX ;YES.
01500 AOS B,JOBFF ;INSERT NEW NUMBER IN TABLE.
01600 HRR A,B
01700 EXCH B,NUMBUC ;UPDATE NUMBUC.
01800 HRRM B,-1(A) ;PUT IN NEW LINK.
01900 HLLM A,-1(A) ;PUT IN TYPE FLAG.
02000 MOVEM C,(A) ;ALSO VALUE.
02100 AOS T,JOBFF ;BUMP POINTER PAST VALUE.
02200 HRLM T,JOBSA
02300 POPJ P,
02400
02500 SNUMX: IOR T,VLOC ;WE WILL PUT NO. IN VARIABLES AREA.
02600 PUSH P,T ;SAVE PTR. TO LOC.
02700 MOVE A,C ;VALUE OF NO. TO A.
02800 MOVEI B,0 ;NO RELOCATION.
02900 PUSHJ P,EMVCDI ;EMIT TO VARIABLES BUFFER.
03000 JRST POPAJ ;SEE EMINST.
00100 ; RESERVED WORD TABLE SEARCHER.
00200
00300
00400 SRSCH: LDB B,[POINT 6,ACCUM,5] ;GET CHAR. COUNT.
00500 CAIL B,3 ;NO 1-CHAR. RES. WDS.
00600 CAILE B,13 ;ALSO NONE OF > 9 CHARS.
00700 JRST SRNO
00800 MOVE B,SRTBL1-2(B) ;GET RIGHT SECTION OF TBL.
00900 CAME A,(B) ;COMPARE FIRST WORD.
01000 SRS1: AOBJN B,.-1
01100 JUMPGE B,SRNO ;ARE WE AT END OF SETCTION ?
01200 CAME C,LRTBL(B) ;NO; COMPARE SECOND WORD.
01300 JRST SRS1
01400 MOVE A,2*LRTBL(B) ;THIS IS IT; GET GOOD BITS.
01500 TLNE A,SSPCF ;DOES IT NEED OUR ATTENTION ?
01600 JRST (A) ;YES.
01700 JRST SEXIT ;NO.
01800
01900 SRNO: TLCN FL,400000 ;NOT A RES. WORD; HAVE WE ALREADY
02000 JRST SMSCH ;SEARCHED MAIN SYM. TBL. ?
02100 JRST SN1 ; YES; RETURN.
02200
02300 .COMME: MOVE A,SNCHR ;A COMMENT; SKIP TO NEXT ';'
02400 SETZM SNCHR
02500 .COMM1: CAMN A,SEMICV
02600 JRST SCAN
02700 TLNE A,SSPCF+SSPC2F ;SPECIAL TREATMENT ?
02800 PUSHJ P,(A) ;YES.
02900 ILDB A,SCP
03000 MOVE A,CTBL(A)
03100 JRST .COMM1
03200
03300
03400 BUCTBL: REPEAT BUCKNO,<EXP TEMPSY> ;TABLE OF HEADS OF THE
03500 ;HASH-CODED BUCKETS IN SYM. TABLE.
03600
03700 NUMBUC: EXP C ;HEAD OF NUMBER TABLE
00100 ;THE CHARACTER CONVERSION TABLE -- GOOD BITS FOR EVERYONE !
00200 ; GET YOURS WHILE THEY LAST !
00300
00400 OPDEF ILG [XWD DF+SSPCF,SILCH]
00500
00600 CTBL: XWD DF+SSPCF,SENDL
00700 REPEAT 10,<ILG>
00800 0 ; HORIZONTAL TAB.
00900 XWD DF+SSPCF,S.LF ;LINE FEED
01000 XWD DF+SSPCF,S.VT ; VERTICAL TAB
01100 XWD DF+SSPCF,S.FF ;FORM FEED
01200 0 ;CARRIAGE RETURN.
01300 REPEAT 14,<ILG>
01400 XWD DF+SSPCF,SENDL ;↑Z.
01500 REPEAT 5,<ILG>
01600 0 ;SPACE
01700 REPEAT 7,<ILG>
01800 LPARV: XWD DF,1
01900 RPARV: XWD DF,2
02000 XWD DF+MULBIT,MULOP ; *
02100 PLSV: XWD DF+ADDBIT,ADDOP ; +
02200 COMMAV: XWD DF,COMMOP ; ,
02300 MINV: XWD DF+ADDBIT,SUBOP ; -
02400 DOTV: XWD SNUMF,"." ; .
02500 XWD DF+MULBIT,DIVOP ; /
02600 CTNUM: REPEAT 12,<XWD SDFLG+SNUMF,20+.-CTNUM> ; THE DIGITS.
02700
02800 COLONV: XWD DF,3 ; :
02900 SEMICV: XWD DF,4 ; ;
03000 XWD DF+SSPCF,S.LT ;<
03100 ;; XWD DF+RELBIT,EOP ; =
03200 XWD DF,ASNOP ;← AND = DO THE SAME THING. 5/74
03300 XWD DF+RELBIT,GOP ; >
03400 REPEAT 2,<ILG>
03500 CTLTR: REPEAT =5,<XWD 0,41+.-CTLTR> ;THE LETTERS.
03600 41+.-CTLTR ;F
03700 REPEAT =9,<41+.-CTLTR>
03800 XWD FOOBIT,41+.-CTLTR+400000 ;P
03900 REPEAT 4,<41+.-CTLTR>
04000 XWD FOOBIT,41+.-CTLTR
04100 REPEAT 5,<41+.-CTLTR>
04200
04300 LFTBRK: XWD DF,5 ; [
04400 ILG
04500 RGTBRK: XWD DF,6
04600 UARV: XWD DF,EXPOP ; ↑
04700 LARV: XWD DF,ASNOP ;← LEFT ARROW??
04800 REPEAT 35,<ILG>
04900 ALTV: XWD DF,. ;ALT MODE.
05000 REPEAT 2,<ILG>
05100 ; END OF CONVERT TABLE.
00100 DEFINE PUT1 (N,Y)
00200 < FOR X IN (Y)
00300 <Q←<SIXBIT /X/>
00400 N*10000000000+(7777777777&(Q/100))
00500 >>
00600
00700 DEFINE PUT2 (Y)
00800 <FOR X IN (Y)
00900 <SIXBIT /X/
01000 >>
01100
01200 RTBL: ;THE RESERVED WORD TABLE.
01300 RT3C: PUT1 (3,END) ;THE 3-LETTER SECTION.
01400 RT4C: PUT1(4,<PLAY>)
01500 RT5C: PUT1(5,<ARRAY>)
01600 RT6C: PUT1 (6,FINIS) ;THE 6-LETTER SECTION.
01700 RT7C: PUT1 (7,<COMME,COMPI>)
01800 RT8C: PUT1 (10,<VARIA,FUNCT,EXTER>) ;VARIABLE
01900 RT10C: PUT1 (12,INSTR) ;
02000
02100 LRTBL←←.-RTBL
02200
02300 RTBL2: 0 ;END
02400 0 ;PLAY.
02500 0
02600 PUT2 (H)
02700 PUT2 (<NT,LE>) ;COMMENT
02800 PUT2 (<BLE,ION,NAL>)
02900 PUT2 (UMENT) ;INSTRUMENT
03000
03100 RF←←DF+RFLG
03200
03300 RTBL3:
03400 ENDV: XWD RF,.
03500 PLAYV: XWD RF,.
03600 ARRV: XWD RF+DECLBIT,DARR
03700 FINV: XWD RF,.
03800 COMV: XWD SSPCF,.COMME
03900 COMPV: XWD RF,.
04000 VARV: XWD RF+DECLBIT,DVRBL
04100 FUNV: XWD RF+DECLBIT,DFUNC ;FUNCTION
04200 EXTV: XWD RF+DECLBIT,EXTD
04300 INSV: XWD RF+DECLBIT,CINS
04400
04500 SRTBL1: 0 ;2
04600 XWD -1,RT3C
04700 XWD -1,RT4C
04800 XWD -1,RT5C
04900 XWD -1,RT6C
05000 XWD -2,RT7C
05100 XWD -3,RT8C
05200 0
05300 XWD -1,RT10C
05400 0
05500 SRSFOO: JUMP 2*LRTBL(B)
00100 ;; MORE BITS AND PARAMETERS.
00200 RELBIT←←0
00300
00400 ;SIZES OF VARIOUS STACKS AND TABLES:
00500 LOBUFS←←200
00600 LUOTBL←←62
00700 LPLIST←←100
00800 LOSTK←←40
00900 LPA←←62
01000 LRQ←←=75 ;LENGTH OF RUN QUEUE.
01100
01200 ;SPECIAL AC DEFINITIONS :
01300 RA←16 ;AC FOR JSA LINKAGE AT RUNTIME.
01400
01500
01600 DEFINE MAKOP1 (X)
01700 <FOR @$ A IN (X)
01800 <A$OP: HALT
01900 >>
02000
02100 MAKOP1 <PW,COMM,L,E,G,EXP,ENDS,WHLS>
02200
02300 ;; TEMPORARY AND DEBUGGING ROUTINES:
02400
02500 GO: MOVE P,[IOWD LPLIST,PLIST]
02600 AOSE ONCEFG ;IS THIS FIRST TIME THROUGH ?
02700 JRST GOA ;NO. LEAVE JOBFF AT CURRENT PLACE.
02800 HRLZ 116 ;YES. GET BOTTOM OF SYM. TAB. FROM JOBSYM.
02900 SUB 116 ;ADD LENGTH OF SYM. TAB.
03000 HRLM JOBFF
03100 GOA: HRR JOBFF
03200 HRLM JOBSA
03300 MOVEI FL,0
03400 PUSHJ P,SETUP
03500 GOB: MOVE P,[IOWD LPLIST,PLIST]
03600 MOVE [JSR ERR1] ;SET UP FOR ERROR UUO.
03700 MOVEM 41
03800 MOVE JOBREL
03900 MOVEM JOBSYM
04000 JRST SCHOWN
04100
04200 ONCEFG: -1
04300
04400 DEFINE ERROR (M)
04500 <XWD 1000,[ASCIZ /M/] >
04600
04700
04800 UDIERR: ERROR (UNDEFINED IDENTIFIER)
04900
05000 SILCH: ERROR (ILLEGAL CHARACTER)
05100 SNUMX1: ERROR(ILLEGAL CHAR. IN NUMBER)
05200 FNDWV: HALT
00100 TEMPSY: EXP TMPS1Z
00200 PUT1 5,OSCIL
00300 XWD UGBIT,.+2
00400 0
00500 JSP RA,@OSCIL ;POINTER DID NOT RESET WITH '1,5,0,1' IN NEXT!!!!
00600 BYTE (6)4,2,2,1,4,0,1;***** JULY 3,71 THIS ENDED '1,5,0,1' ****
00700 TMPS1Z: TMPS1
00800 PUT1 6,ZOSCI
00900 XWD UGBIT,.+3
01000 PUT2 (L)
01100 0
01200 JSP RA,@ZOSCIL
01300 BYTE (6)4,2,2,1,5,0,1
01400 ;CHANGE LAST OF ABOVE TO .. 4,0,1 TO MAKE ZOSCIL NOT LIKE COSCIL
01500 TMPS1: EXP TIMESC+1
01600 PUT1 6,TIMES
01700 XWD VRBLBT,TIMESC
01800 PUT2 C
01900 TIMESC: 1.0
02000 EXP SRATE+1
02100 PUT1 5,SRATE
02200 XWD VRBLBT,SRATE
02300 SRATE: 10000.0
02400 EXP NCHNS+1
02500 PUT1 5,NCHNS
02600 XWD VRBLBT,NCHNS
02700 NCHNS: 1
02800 EXP LSBUF+1
02900 PUT1 5,LSBUF
03000 XWD VRBLBT,LSBUF
03100 LSBUF: 1000
03200 EXP TMPS2
03300 PUT1 3,OUT
03400 XWD UGBIT,.+2
03500 0
03600 JSA RA,@OUT
03700 BYTE (6)1,2,0,0
03800 TMPS2: EXP TMPS3
03900 PUT1 4,OUT2
04000 XWD UGBIT,.+2
04100 0
04200 JSA RA,@OUT2
04300 BYTE (6)3,2,2,2,0,0
04400 TMPS3: TMPS3A
04500 PUT1 5,SPEED
04600 XWD VRBLBT,SPEED
04700 SPEED: 1
04800 TMPS3A: TMPS11
04900 PUT1 6,ZINTR
05000 XWD UGBIT,.+3
05100 PUT2 P
05200 JSA RA,IINTRP
05300 JSP RA,@ZINTRP
05400 BYTE (6)5,2,2,5,1,4,0,T
05500
05600 TMPS11: TMNOSA
05700 PUT1 6,VFMUL
05800 XWD UGBIT,.+3
05900 PUT2 T
06000 0
06100 JSP RA,@VFMULT
06200 BYTE (6)3,2,2,1,0,T
06300 ; OSCIL IS NOW THE NOSCIL...JMG 7/14/73
06400
06500 ; SOMEDAY, IF IT IS EVER USED, SOMEONE COULD CHANGE
06600 ; THE NAME OF NOSCA TO OSCA, ETC.
06700 ;TMPS12: TMNOSA
06800 ; PUT1 6,NOSCI
06900 ; XWD UGBIT,.+3
07000 ; PUT2 L
07100 ; 0
07200 ; JSP RA,@NOSCIL
07300 ; BYTE (6)4,2,2,1,4,0,1
07400
07500 TMNOSA: TMPS13
07600 PUT1 5,NOSCA
07700 XWD UGBIT,.+2
07800 JSA RA,INOSCA
07900 JSP RA,@NOSCA
08000 BYTE (6)5,2,2,2,1,5,0,T
08100
08200 ;TMPS13: TMPS14
08300 ; PUT1 10,DISKF
08400 ; XWD VRBLBT,DISKFL
08500 ; PUT2 LAG
08600 ;DISKFL: 0
08700
08800 TMPS13: TMPS15
08900 PUT1 5,INTRP
09000 XWD UGBIT,.+2
09100 JSA RA,IINTRP
09200 JSP RA,@INTRP
09300 BYTE (6)5,2,2,5,1,4,0,T
09400 ;TMPS24: TMPS14
09500 ; PUT1 4,READ
09600 ; XWD UGBIT,.+2
09700 ; JSP RA,READI
09800 ; JSP RA,@READ
09900 ; BYTE (6)6,2,2,1,2,5,5,0,T
10000 ;TMPS14: TMPS15
10100 ; PUT1 4,REVX
10200 ; XWD UGBIT,.+2
10300 ; JSP RA,REVXI
10400 ; JSP RA,@REVX
10500 ; BYTE (6)20,2,2,2,2,2,2,2,2,2,4,4,4,4,4,1,4,0,T
10600
10700 TMPS15: .+3
10800 PUT1 4,OUTA
10900 XWD VRBLBT,OUTA
11000 ; .+3
11100 ; PUT1 4,OUTB
11200 ; XWD VRBLBT,OUTB
11300 ; .+3
11400 ; PUT1 4,OUTC
11500 ; XWD VRBLBT,OUTC
11600 ; .+4 ;DOPLAY←1=WILL PLAY WHEN WRITING SMPLS ON DSK
11700 ; PUT1 6,DOPLA
11800 ; XWD VRBLBT,DOPLAY#
11900 ; PUT2 Y
12000 ; .+3
12100 ; PUT1 4,OUTD
12200 ; XWD VRBLBT,OUTD
12300 .+4 ;RCDFLG←1 PUTS SAMPLES ON DSK UNDER 'MUSAA','MUSAB',ETC.
12400 PUT1 6,RCDFL
12500 XWD VRBLBT,RCDFLG#
12600 PUT2 G
12700 ; .+4
12800 ; PUT1 6,BIGBI
12900 ; XWD VRBLBT,BIGBIT#
13000 ; PUT2 T
13100 ; .+6
13200 ; PUT1 5,VALUE
13300 ; XWD UGBIT,.+2
13400 ; 0
13500 ; JSP RA,@VALUE
13600 ; BYTE (6)1,2,0,T
13700 .+5
13800 PUT1 4,RAND
13900 XWD FUNBIT,.+1
14000 PUSHJ P,RAND
14100 BYTE (6)0,T
14200 ;S FRSTB+1
14300 ;S PUT1 =9,FIRST
14400 ;S XWD VRBLBT,FRSTB
14500 ;S PUT2 BAND
14600 ;SFRSTB: 0
14700 .+5
14800 PUT1 5,PRINT
14900 XWD FUNBIT,.+1
15000 JSA RA,FOOPRT
15100 BYTE (6)1,2,0,0
15200 ; .+3
15300 ; PUT1 3,RDA
15400 ; XWD RVBT∨VRBLBT,RDA
15500 ; .+3
15600 ; PUT1 3,RDB
15700 ; XWD RVBT∨VRBLBT,RDB
15800 ; .+3
15900 ; PUT1 3,RDC
16000 ; XWD RVBT∨VRBLBT,RDC
16100 ; .+3
16200 ; PUT1 3,RDD
16300 ; XWD RVBT∨VRBLBT,RDD
00100 TMPSA: EXP TMPS4 ;LINEN.
00200 PUT1 5,LINEN
00300 XWD UGBIT,.+2
00400 JSA RA,LINEN1
00500 JSP RA,@LINEN
00600 ; BYTE (6)13,4,4,4,2,2,2,2,1,4,4,4,0,1
00700 BYTE (6)13,4,4,4,2,2,2,2,1,2,4,4,0,1
00800 ;NOW YOU MUST RESET PTR IN LINEN
00900 TMPS4: EXP TMPS4A
01000 ;TMPS4: EXP TMPS5
01100 PUT1 5,EXPEN
01200 XWD UGBIT,.+2
01300 0
01400 JSP RA,@EXPEN
01500 BYTE (6)4,2,2,1,4,0,1
01600
01700 TMPS4A: EXP TMPS8
01800 PUT1 6,ZEXPE
01900 XWD UGBIT,.+3
02000 PUT2 N
02100 0
02200 JSP RA,@ZEXPEN
02300 BYTE (6)4,2,2,1,4,0,1
02400
02500 ;TMPS5: EXP TMPS6
02600 ; PUT1 (4,REV1) ;REV1
02700 ; XWD UGBIT,.+2
02800 ; JSP RA,REVI
02900 ; JSP RA,@REV1
03000 ; BYTE (6)6,2,2,2,1,5,4,0,1
03100 ;TMPS6: EXP TMPS7
03200 ; PUT1 4,REV2
03300 ; XWD UGBIT,.+2
03400 ; JSP RA,REVI
03500 ; JSP RA,@REV2
03600 ; BYTE (6)6,2,2,2,1,5,4,0,1
03700
03800 ;TMPS7: EXP TMPS8
03900 ; PUT1 (7,REVIN) ;REVINIT.
04000 ; XWD VRBLBT,REVINI
04100 ; PUT2 IT
04200 ;REVINI: 0
04300
04400 TMPS8: EXP TMPS9
04500 PUT1 (5,RANDH)
04600 XWD UGBIT,.+2
04700 JSP RA,IRANDH
04800 JSP RA,@RANDH
04900 BYTE (6)4,2,2,4,4,0,1
05000 TMPS9: EXP TMPS10
05100 PUT1 (5,RANDI)
05200 XWD UGBIT,.+2
05300 JSP RA,IRANDI
05400 JSP RA,@RANDI
05500 BYTE (6)5,2,2,4,4,4,0,1
05600 TMPS10: EXP A-1
05700 PUT1 6,COSCI
05800 XWD UGBIT,.+3
05900 PUT2 L
06000 0
06100 ; JSP RA,@NOSCIL
06200 JSP RA,@OSCIL
06300 BYTE (6)4,2,2,1,5,0,1
06400
00100 ;; HERE ARE SOME WONDERFUL UNIT GENERATORS.
00200
00300 ; THIS IS THE OLD OSCIL WHICH DOESN'T LIKE NEG. INCS.
00400 ;OSCIL: MOVE INSXR,3(RA)
00500 ; FIX INSXR,233000
00600 ; TRZE INSXR,777000
00700 ; JSP T1,OSCIL1
00800 ; MOVE T,@2(RA)
00900 ; FMPR T,@(RA)
01000 ; SKIPGE T1,@1(RA) ;OSCIL DOESN'T WANT NEG. INC.
01100 ; ERROR (NEGATIVE INC. TO OSCIL)
01200 ; FADM T1,3(RA)
01300 ; JRST 4(RA)
01400 NOSCA: ADDI RA,1
01500 ;NOSCIL: MOVE INSXR,3(RA)
01600 OSCIL: MOVE INSXR,3(RA)
01700 ;;*** CAUSE OF ROUNDOFF PROBS???? FAD INSXR,[0.5]
01800 ;; HRLZI T1,233000
01900 ;; UFA T1,INSXR
02000 ; THE ABOVE 2 INST'S REPLACE THE FIX FOR INDEXING
02100 FIX INSXR,233000
02200 TRZE INSXR,777000
02300 JSP T1,OSCIL1
02400 MOVE T,@2(RA)
02500 FMPR T,@(RA)
02600 MOVE T1,@1(RA)
02700 FADM T1,3(RA)
02800 JRST 4(RA)
02900 OSCIL1: MOVSI (-512.0) ;WRAP AROUND THE POINTER.
03000 JUMPGE INSXR,.+2
03100 MOVNS 0 ;IF NEG. INC., WRAP AROUND OTHER WAY.
03200 FADM 3(RA)
03300 HRLI INSXR,0 ;TO ALLOW ZOSCIL=NOSCIL
03400 JRST (T1)
03500
03600 OUT: 0
03700 MOVE @(RA) ;PICK UP INPUT.
03800 FADM OUTA ;ACCUMULATE INTO OUTPUT ARRAY.
03900 POPJ P, ;RETURN FROM INSTRUMENT.
04000
04100 OUT2: 0
04200 MOVE @(RA)
04300 MOVE 1,0
04400 FMP @1(RA)
04500 FADM OUTA ;
04600 ; FMP 1,@2(RA)
04700 ; FADM 1,OUTB
04800 POPJ P,
04900
05000 EXPEN: MOVE INSXR,@1(RA) ;GET INCREMENT.
05100 FADB INSXR,3(RA) ;INCREMENT POINTER.
05200 FIX INSXR,233000
05300 ;; HRLZI T1,233000
05400 ;; UFA T1,INSXR
05500 ; CAIL INSXR,777 ;IF GREATER THAN 512, STICK
05600 TRZE INSXR,777000
05700 EXPEN2: MOVEI INSXR,777 ;AT LAST ELEMENT OF ARRAY.
05800 MOVE T,@2(RA) ;GET ARRAY ELEMENT.
05900 FMPR T,@(RA) ;MULTIPLY BY AMPLITUDE.
06000 JRST 4(RA) ;RETURN.
06100 VFM2: FSBR INSXR,[512.0] ;YOU MUST NOW SET PTR FOR VFMULT!
06200 MOVEM INSXR,@VFMULT
06300
06400 VFMULT: MOVE INSXR,@1(RA) ;GET POINTER INPUT.
06500 CAML INSXR,[512.0]
06600 JRST VFM2
06700 FIX INSXR,233000
06800 ;; HRLZI T1,233000
06900 ;; UFA T1,INSXR
07000 MOVE T,@2(RA) ;GET INDICATED ELEMENT OF ARRAY.
07100 FMPR T,@(RA) ;MULT. BY AMPLITUDE.
07200 JRST 3(RA)
07300
07400 INOSCA: 0
07500 MOVE T,(RA)
07600 MOVE T1,@-6(T)
07700 MOVEM T1,-2(T)
07800 JRA RA,1(RA)
07900 INTRP: ADDI RA,1
08000 MOVE INSXR,3(RA)
08100 FIX INSXR,233000
08200 ;; HRLZI T1,233000
08300 ;; UFA T1,INSXR
08400 TRZE INSXR,777000
08500 JSP T1,OSCIL1
08600 MOVE T,@2(RA)
08700 FMPR T,@(RA)
08800 FADR T,@-1(RA)
08900 MOVE T1,1(RA)
09000 FADM T1,3(RA)
09100 JRST 4(RA)
09200
09300 IINTRP: 0
09400 MOVE T,(RA)
09500 MOVE T1,@-5(T)
09600 FSBR T1,@-6(T)
09700 MOVEM T1,@-5(T)
09800 MOVSI T1,(512.0)
09900 FDVR T1,SRATE
10000 FDVR T1,PBASE+2
10100 MOVEM T1,-4(T)
10200 JRA RA,1(RA)
10300
10400 ZEXPEN: SKIPGE INSXR,3(RA) ;ZEXPEN WORKS LIKE ZOSCIL AND EXPEN!
10500 JRST[ ERROR (NEGATIVE INC. TO ZEXPEN)
10600 JSP T1,OSCIL1 ;DO WRAPAROUND ANYWAY
10700 JRST .+1] ;LET THE LOSER CONTINUE
10800 ; IT TAKES THESE 4 INST'S TO DO A GOOD FIX FOR FURTHER USE
10900 FIX INSXR,233000
11000 ;; HRLZI T1,233000
11100 ;; UFA T1,INSXR
11200 ;; JUMPE INSXR,.+2
11300 ;; TLC INSXR,233000
11400 CAIL INSXR,777 ;IF GREATER THAN 511, STICK
11500 JRST EXPEN2 ;AT LAST ELEMENT (WE WON'T NEED TO INTERPOLATE)
11600 MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
11700 move insxr ;SAVE INDEX
11800 move t1,t ;COPY FIRST ELEMENT
11900 addi insxr,1 ;NO, INCREMENT INDEX
12000 fsbr t1,@2(ra) ;GET DWFFERENCE IN VALUE I
12100 fsc 233 ;(FLOAT THE INDEX)
12200 fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
12300 fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
12400 fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
12500 FMPR T,@(RA) ;SCALED BY AMPLITUDE
12600 MOVE T1,@1(RA) ;UPDATE SUM OF INCREMENTS
12700 FADM T1,3(RA)
12800 JRST 4(RA)
12900
13000 ZINTRP: ADDI RA,1 ;AN INTERPOLATING INTRP!
13100 MOVE INSXR,3(RA)
13200 FIX INSXR,233000
13300 ;; HRLZI T1,233000
13400 ;; UFA T1,INSXR
13500 ;; JUMPE INSXR,.+2
13600 ;; TLC INSXR,233000
13700 TRZE INSXR,777000 ;DID WE RUN OVER?
13800 JSP T1,OSCIL1 ;YES, DO WRAPAROUND (BUT IT REALLY SHOULDN'T!)
13900 MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
14000 move insxr ;SAVE INDEX
14100 move t1,t ;COPY FIRST ELEMENT
14200 cain insxr,777 ;ARE WE AT THE LAST ELEMENT
14300 tdza insxr,insxr ;YES, SET INDEX TO ZERO AND SKIP
14400 addi insxr,1 ;NO, INCREMENT INDEX
14500 fsbr t1,@2(ra) ;GET DIFFERENCE IN VALUE I
14600 fsc 233 ;(FLOAT THE INDEX)
14700 fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
14800 fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
14900 fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
15000 MOVE @(RA) ;GET SECOND VALUE
15100 FSBR @-1(RA) ;SUBTRACT THE FIRST
15200 FMPR T,0 ;MULIPLY BY DIFFENCE BETWEEN TWO VALUES
15300 FADR T,@-1(RA) ;AND ADD TO THE FIRST VALUE
15400 MOVE T1,1(RA) ;UPDATE SUM OF INCREMENTS
15500 FADM T1,3(RA)
15600 JRST 4(RA)
15700
15800 ;READ: AOS INSXR,4(RA)
15900 ; CAML INSXR,5(RA)
16000 ; JRST READ1
16100 ; MOVEI T,0
16200 ;LCS2: MOVE @2(RA)
16300 ; MOVEM RDA(T)
16400 ; ADDI T,1
16500 ; CAML T,3(RA)
16600 ; JRST 7(RA)
16700 ; AOS INSXR,4(RA)
16800 ; JRST LCS2
16900
17000 ;READ1: MOVE 2(RA)
17100 ; MOVEM LCS+3
17200 ; SUBI 1
17300 ; HRRZM LCS+4
17400 ;LCS: JSA 16,READIN
17500 ; 0
17600 ; 0
17700 ; 0
17800 ; 0
17900 ; [-1]
18000 ; SETZB INSXR,4(RA)
18100 ; JRST READ+3
18200
18300 ;READI: MOVE T,(RA)
18400 ; MOVE T2,@-4(T)
18500 ; FIX T2,233000
18600 ;******↑↑↑↑↑↑ OK FOR EXPORT ????? 5/74
18700 ; MOVEM T2,-4(T)
18800 ; MOVE T2,-7(T)
18900 ; MOVEM T2,LCS1+1
19000 ; MOVE T2,-6(T)
19100 ; MOVEM T2,LCS1+2
19200 ; MOVE T1,-5(T)
19300 ; MOVE T2, -1(T1)
19400 ; MOVEM T2,-2(T)
19500 ; SETOM -3(T)
19600 ; MOVEM T1,LCS1+3
19700 ;LCS1: JSA RA,READIN
19800 ; 0
19900 ; 0
20000 ; 0
20100 ; T2
20200 ; [0]
20300 ; JRST 1(RA)
20400
20500 ZOSCIL: MOVE INSXR,3(RA) ;ZOSCIL WORKS LIKE COSCIL AND NOSCIL!
20600 FIX INSXR,233000
20700 ;; HRLZI T1,233000
20800 ;; UFA T1,INSXR
20900 ;; JUMPE INSXR,.+2
21000 ;; TLC INSXR,233000
21100 TRZE INSXR,777000
21200 JSP T1,OSCIL1
21300 MOVE T,@2(RA)
21400 move insxr
21500 move t1,t
21600 cain insxr,777
21700 tdza insxr,insxr
21800 addi insxr,1
21900 fsbr t1,@2(ra)
22000 fsc 233
22100 fsb 3(ra)
22200 fmpr t1,0
22300 fadr t,t1
22400 FMPR T,@(RA)
22500 MOVE T1,@1(RA)
22600 FADM T1,3(RA)
22700 JRST 4(RA)
22800
00100 ;; REVERBERATION UNIT GENERATORS.
00200 ; REV1 IS THE SIMPLE FED-BACK DELAY LOOP, OR 'COMB FILTER'.
00300
00400 ;REV1: AOS INSXR,4(RA) ;INCREMENT OUTPUT PTR.
00500 ; CAML INSXR,5(RA) ;IS IT TIME TO WRAP AROUND ?
00600 ; SETZB INSXR,4(RA) ;YES.
00700 ; MOVE 1,@3(RA) ;GET OUTPUT OF DELAY LINE.
00800 ; MOVE 2,1 ;LEAVE IN 1 AS FINAL OUTPUT.
00900 ; FMPR 2,@2(RA) ;MULTIPLY BY FEEDBACK GAIN.
01000 ;REVA: MOVE @1(RA) ;GET DELAY TIME, T.
01100 ; FIX 233000
01200 ; ADD INSXR,0 ;MOVE PTR. AROUND TO INPUT END.
01300 ; CAML INSXR,5(RA) ;PROBABLY HAVE TO WRAP AROUND..
01400 ; SUB INSXR,5(RA) ;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
01500 ; THE ABOVE 5 INSTRUCTIONS ALLOW A DYNAMICALLY CONTROLLED
01600 ; DELAY TIME IN REVERB. TO INSTITUTE, CHANGE THE LOC. OF
01700 ; 'REVA:' BACK TO ABOVE AND DE-COMMENT. THE PRESENT REVERB
01800 ; ASSUMES THAT THE ARRAY LENGTH IS THE DELAY, SO THE ARGU-
01900 ; MENT IN THE UG IS IGNORED... JMG 7/14/73
02000 ;REVA: FADR 2,@(RA) ;ADD IN THE INPUT SAMPLE.
02100 ; JFCL 1,[SETZB 2,1 ;FLOAT. UNDER FLOW
02200 ; SETOM FXUFLG#
02300 ; JRST .+1] ;THESE WERE ON JC,MUS. WHY???
02400 ; MOVEM 2,@3(RA) ;PLACE IN INPUT OF DELAY LINE.
02500 ; JRST 6(RA) ;RETURN.
02600
02700 ;REV2 IS THE ALL-PASS REVERBERATOR.
02800
02900 ;REV2: AOS INSXR,4(RA) ;CALC. PTR. AS IN REV1.
03000 ; CAML INSXR,5(RA)
03100 ; SETZB INSXR,4(RA)
03200 ;; MOVN 1,@3(RA) ;GET NEGATIVE OF OUTPUT OF DELAY.
03300 ;; MOVN 0,@2(RA) ;ALSO NEGATIVE OF GAIN, G.
03400 ;; FMPR 1,0 ;FORM GAIN*OUTPUT
03500 ;; MOVE 2,1 ;(NOTE THIS IS POSITIVE).
03600 ;; FMPR 1,0 ;FORM -G↑2 * OUTPUT.
03700 ;; FADR 1,@3(RA) ;(1-G↑2) * OUTPUT.
03800 ;; FMPR 0,@(RA) ;FORM -G * INPUT.
03900 ;; FADR 1,0 ;FINAL OUTPUT IS -G*IN +(1-G↑2)*OUT.
04000 ;; JRST REVA ;FROM HERE ON, SAME AS REV1.
04100 ; MOVE 2,@2(RA) ;GET GAIN, G
04200 ; FMPR 2,@(RA) ;MULTIPLY BY INPUT
04300 ; FADR 2,@3(RA) ;ADD IN OUTPUT OF DELAY
04400 ; MOVN 1,2 ;TAKE -(OUTPUT+G+IN)
04500 ; FMPR 1,@2(RA) ;SCALE BY GAIN
04600 ; FADR 1,@(RA) ;ADD INPUT
04700 ; JFCL 1,[SETZB 2,1 ;FLOATING UNDERFLOW
04800 ; SETOM FXUFLG#
04900 ; JRST .+1]
05000 ; MOVEM 1,@3(RA) ;NEW DELAY INPUT
05100 ; JRST 6(RA) ;RETURN WITH ANSWER IN 2
05200 ; NEW REV. 1 LESS MULT. A.MOORER, 5/74
05300
05400 ; THIS IS THE I-TIME CODE FOR REV1 AND REV2.
05500
05600 ;REVI: HRRZ T1,(RA) ;GET PTR. TO END OF REV PARAMS.
05700 ; MOVNI INSXR,1 ;INSXR←-1
05800 ; HRRZ @-4(T1) ;GET -1ST ELEMENT OF ARRAY (THE LENGTH)
05900 ; MOVEM -2(T1) ;PLACE IN THE SECOND DUMMY PARAM.
06000 ; SKIPN REVINI ;SHOULD WE INIT. THE DELAY ARRAY ?
06100 ; JRST 1(RA) ;NO.
06200 ; SETZM -3(T1) ;YES. FIRST CLEAR THE POINTER LOC.
06300 ; HRRZ T,-4(T1) ;GET PTR. TO ARRAY.
06400 ;REVI2: ADDI -1(T) ; 0 NOW POINTS TO TOP OF ARRAY.
06500 ; HRL T,T
06600 ; SETZM (T) ;CLEAR FIRST ELEMENT OF ARRAY.
06700 ; ADDI T,1 ;FORM BLT POINTER.
06800 ; BLT T,@0 ;CLEAR REST OF ARRAY.
06900 ; JRST 1(RA)
07000
00100 ;; MORE GENERATORS.
00200
00300 LINEN: MOVE INSXR,11(RA) ;GET INCREMENT.
00400 ; FADB INSXR,10(RA) ;ADD TO POINTER.
00500 FADB INSXR,@10(RA) ;NOW YOU MUST RESET PTR
00600 LINEN4: CAML INSXR,12(RA) ;ARE WE PAST END OF SECTION ?
00700 JRST LINEN2 ;YES.
00800 FIX INSXR,233000
00900 MOVE T,@3(RA) ;AMPLITUDE.
01000 FMPR T,@7(RA) ;MULT. BY ARRAY ELEMENT.
01100 JRST 13(RA) ;RETURN.
01200
01300 LINEN2: MOVE T,12(RA) ;PICK UP CURRENT LIMIT.
01400 FIX T,242000
01500 CAIL T,3 ;END OF ARRAY ?
01600 JRST LINEN3 ;YES.
01700 HRLI T,RA ;PREPARE FOR INDEXING...
01800 MOVE @T ;PICK UP NEXT INCREMENT.
01900 MOVEM 11(RA) ;PUT AWAY.
02000 MOVSI (128.0)
02100 FADM 12(RA) ;INCREMENT LIMIT TO NEXT VALUE.
02200 JRST LINEN4
02300 LINEN3: MOVEI 14(RA) ;FAKE UP A PARAMETER FOR LINEN1.
02400 MOVEM .+2
02500 JSA RA,LINEN1 ;RE-INITIALIZE THE GENERATOR.
02600 0 ;
02700 ; SETZM 10(RA) ;RESET PTR.
02800 SETZM @10(RA) ;NOW YOU MUST RESET PTR
02900 SETZM 11(RA) ;AND INCREMENT.
03000 SETZM 12(RA) ;...AND LIMIT.
03100 JRST LINEN
03200
03300 LINEN1: 0 ;THE INITIALIZING CODE FOR LINEN.
03400 MOVE T2,(RA) ;GET POINTER TO END OF PARAMETERS.
03500 MOVE T1,TIMESC ;CALC. 128*(BEATS/SAMPLE)
03600 FDVR T1,SRATE
03700 FSC T1,7
03800 MOVE T,@-10(T2) ;GET RISE TIME IN BEATS.
03900 FDVRM T1,T ;INCREMENT←T1/TIME (=128/(TIME IN SAMPS))
04000 MOVEM T,-14(T2) ;PLACE IN PARAMETER 0.
04100 MOVE T,@-6(T2) ;DURATION OF NOTE IN BEATS...
04200 FSBR T,@-7(T2) ;...MINUS FALL TIME..
04300 FSBR T,@-10(T2) ;...MINUS RISE TIME.
04400 FDVRM T1,T ;CHANGE TO INCREMENT.
04500 MOVEM T,-13(T2) ;PLACE IN PARAMETER 1.
04600 FDVR T1,@-7(T2) ;INCREMENT FOR FALL TIME.
04700 MOVEM T1,-12(T2) ;PLACE IN PARAMETER 2.
04800 JRA RA,1(RA)
04900
05000 ;VALUE: MOVE T,@(RA) ;DUMMY UNIT GENERATOR... OUTPUT IS
05100 ; JRST 1(RA) ;SAME AS ITS PARAMETER.
00100 ;; RANDOM NUMBER GENERATORS.
00200
00300 RANDH: MOVE @1(RA) ;GET INCREMENT.
00400 FADB 2(RA) ;INCREMENT THE 'POINTER'.
00500 CAML [512.0] ;OVER 512 ?
00600 JRST RNDH2 ;YES. GO GET NEW RANDOM NUMBER.
00700 MOVE T,@(RA) ;NO. GET INPUT ...
00800 FMPR T,3(RA) ;... AND MULT. BY CURRENT RANDOM NO.
00900 JRST 4(RA) ;RETURN.
01000 RNDH2: MOVSI (-512.0) ;CAUSE 'POINTER' TO 'WRAP AROUND'.
01100 FADM 2(RA)
01200 PUSHJ P,RAND ;GET NEW RANDOM NO.
01300 MOVEM T,3(RA) ;MAKE IT THE CURRENT NO.
01400 FMPR T,@(RA) ;MULT. BY INPUT.
01500 JRST 4(RA) ;RETURN.
01600
01700 IRANDI: ;I-TIME CODE FOR RANDI AND RANDH.
01800 IRANDH: PUSHJ P,RAND ;INIT. RANDH.
01900 MOVE T2,(RA) ;GET PTR. TO LAST PARAM..
02000 MOVEM T,-2(T2) ;PUT INITIAL RAND. NO. IN.
02100 JRST 1(RA)
02200
02300 RANDI: MOVE T,2(RA) ;GET CURRENT DELTA..
02400 FADRB T,4(RA) ;ADD TO LAST OUTPUT VALUE...
02500 SOSG 3(RA) ;DECREMENT STEP COUNTER ...
02600 JRST RNDI2 ;IT'S 0, SO GET NEW RANDOM NO.
02700 FMPR T,@(RA) ;NO. MULT BY INPUT.
02800 JRST 5(RA) ;RETURN.
02900 RNDI2: PUSHJ P,RAND ;GET NEXT RANDOM NO.
03000 FSBR T,4(RA) ;FORM DELTA (=NEW - OLD)
03100 MOVSI T1,(512.0)
03200 FDVR T1,@1(RA) ;NO. OF STEPS = 512/(FREQ. INPUT)
03300 FDVR T,T1 ;CHANGE PER STEP =DELTA/NO. OF STEPS
03400 MOVEM T,2(RA) ;STORE CHANGE PER STEP.
03500 FIX T1,233000
03600 ;**********↑↑↑↑↑↑↑
03700 MOVEM T1,3(RA) ;PUT IT AWAY.
03800 JRST RANDI ;NOW GO GENERATE FIRST STEP.
03900
04000 RAND: MOVE T,RNDNO1 ;GENERATE A RANDOM NO.
04100 ADD T,RNDNO2
04200 EXCH T,RNDNO2
04300 MOVEM T,RNDNO1
04400 ASH T,-10 ;SMEAR SIGN INTO EXPONENT FIELD..
04500 FSC T,200 ;... AND FLOAT IT IN RANGE -1 TO 1.
04600 POPJ P,
04700 RNDNO1: 756132257563
04800 RNDNO2: 756132257565
00100 PLIST: BLOCK LPLIST
00200
00300 OSTK: BLOCK LOSTK
00400
00500 RQ1: BLOCK LRQ ;THE RUN QUEUE, CLOUMN ONE.
00600 RQ2: BLOCK LRQ ;COLUMN TWO.
00700
00800 PATCH: BLOCK 100
00900
01000 IARR1: ;; HERE BEGINS AN AREA WHICH IS ZEROED DURING
01100 ; INITIALIZATION OF EACH COMPILATION.
01200
01300 UOTBL: BLOCK LUOTBL
01400
01500 ACS:
01600 RACS: BLOCK 20
01700 IACS: BLOCK 20
01800
01900 UOPTR: -1
02000
02100 IARR2:
02200
02300 PBASE: BLOCK LPA
02400
02500 OUTA: 0 ;CHANNEL A OUTPUT SAMPLE ACCUMULATED HERE.
02600 ;OUTB: 0 ;CHANNEL B.
02700 ;OUTC: 0 ;CHANNEL C.
02800 ;OUTD: 0 ;CHANNEL D.
02900
03000 ;RDA: 0
03100 ;RDB: 0
03200 ;RDC: 0
03300 ;RDD: 0
03400
03500 IARR3:
03600
03700
03800 VLOC: 0
03900 ILOC: 0
04000 RLOC: 0
04100
04200 DSKMAX: =76*2000*17
00100 ;; THIS IS THE MULTIPLE-FEEDBACK REVERBERATOR.
00200 ;; ITS DELAY TIMES MUST NOT BE R-TIME VARIABLES.
00300
00400 ;REVX: SOSGE INSXR,15(RA) ; ADVANCE PTR. TO 4TH TAP.
00500 ; JSP T1,REVX1 ;TIME TO WRAP AROUND....
00600 ; MOVE T,@16(RA) ;GET DELAY ARRAY OUTPUT FROM 4TH TAP..
00700 ; FMP T,@10(RA) ;MULT. BY GAIN NO. 4
00800 ; SOSGE INSXR,14(RA) ;NOW PTR. TO 3RD TAP.
00900 ; JSP T1,REVX1
01000 ; MOVE @16(RA) ;... 3RD TAP DELAY OUTPUT...
01100 ; FMP @6(RA) ;...3RD GAIN...
01200 ; FAD T,0 ;ACCUMULATE SUM IN T.
01300 ; SOSGE INSXR,13(RA) ;2ND TAP PTR.
01400 ; JSP T1,REVX1 ;THIS COULD GET BORING.
01500 ; MOVE @16(RA)
01600 ; FMP @4(RA) ;GAIN 2.
01700 ; FAD T,0
01800 ; SOSGE INSXR,12(RA) ;ONE MORE CHORUS.
01900 ; JSP T1,REVX1
02000 ; MOVE @16(RA)
02100 ; FMP @2(RA) ;GAIN 1.
02200 ; FADB T,0 ;T NOW HAS FINAL OUTPUT(=SUM OF
02300 ; TAPS * GAINS).
02400 ; FAD @(RA) ;ADD OUTPUT TO INPUT ..
02500 ; SOSGE INSXR,11(RA) ;.. GET PTR. TO INPUT OF DELAY..
02600 ; JSP T1,REVX1
02700 ; MOVEM @16(RA) ;AND PUT IT THERE.
02800 ; JRST 20(RA) ;WOULD YOU BELIEVE 20 PARAMETERS ??!
02900
03000 ;REVX1: ADD INSXR,17(RA) ;A PTR. HAS UNDERFLOWED; ADD
03100 ; MOVEM INSXR,@-2(T1) ; LENGTH OF ARRAY TO IT TO WRAP
03200 ; JRST (T1) ;IT AROUND (AND STORE UPDATED VERSION).
00100
00200 ;REVXI: MOVE T1,(RA) ;INITIALIZING FOR REVX.. GET PTR. TO PARAMMS.
00300 ; MOVNI INSXR,1
00400 ; MOVE @-3(T1) ;GET -1ST ELEMENT OF ARRAY (= ITS LENGTH).
00500 ; MOVEM -2(T1) ;STORE IN LAST DUMMY PARAM.
00600 ; SKIPE REVINI ;IF WE ARE INITIALIZING REVERBERATORS,
00700 ; SETZM -10(T1) ;RESET INPUT PTR. OF DELAY TO BOTTOM OF ARRAY.
00800 ; MOVSI T,-4 ;NOW WE SET UP THE FOUR DELAY OUTPUT TAP
00900 ; HRRI T,-7(T1) ;PTRS. THE RIGHT DISTANCE BEHIND THE INPUT PTR.
01000 ; MOVEI T2,-20(T1) ;
01100 ;REVXI2: MOVE @(T2) ;PICK UP DELAY TIME (IN SAMPLES).
01200 ; FIX 233000
01300 ;**********↑↑↑↑↑↑↑↑
01400 ; ADD -10(T1) ;ADD TO INPUT PTR. POSITION.
01500 ; CAML -2(T1) ;WRAP AROUND ?
01600 ; SUB -2(T1) ;YES. SUB. LENGTH OF ARRAY.
01700 ; MOVEM (T) ;PLACE PTR. IN RIGHT DUMMY PARAM.
01800 ; ADDI T2,2 ;INC. T2 TO POINT AT NEXT DELAY TIME PARAM.
01900 ; AOBJN T,REVXI2 ;LOOP TO GET ALL 4 DELAY TAPS.
02000 ; SKIPN REVINIT ;ARE WE INITIALIZING REVERBERATORS ?
02100 ; JRST 1(RA) ;NO. RETURN.
02200 ; MOVE -2(T1) ;YES GET LENGTH OF ARRAY.
02300 ; HRRZ T,-3(T1) ;GET BASE OF ARRAY.
02400 ; JRST REVI2 ;GO ZERO ARRAY (SEE REV1 AND REV2 PAGE).
00100 ; ***** COMPX BEGINS HERE **** ROUTINES TO EMIT CODE AND STUFF TO OUTPUT BUFFERS.
00200 EMDV: SETZB A,B ;EMIT A DUMMY VARIABLE (TO RESERVE
00300 ; SPACE IN THE VARIABLES AREA).
00400 EMVCDI: AOS VLOC
00500 EMVCD: MOVEI T1,2 ;EMIT TO VARIABLE BUFFER.
00600 JRST ECD
00700 EMIABS: TDZA B,B ;EMIT TO I-TIME BUF. , NO RELOC.
00800 EMCDI: AOSA RLOC ;SKIP INSTRUCTIONS WIN BIG.
00900 EMICDI: AOSA ILOC ; SEE THE HAPPY INTERLEAVED CODE !
01000 EMCD: TDZA T1,T1 ;EMIT TO RUNTIME BUFFER.
01100 EMICD: MOVEI T1,1 ;EMIT TO INITIALIZE TIME BUFFER.
01200 ECD:
01300 IDPB A,EMPTR(T1) ;EMIT THE WORD.
01400 IDPB B,RELPTR(T1) ;ALSO ITS RELOCATION BITS.
01500 AOSGE BUFCNT(T1) ;IS BUFFER FULL ?
01600 POPJ P, ;NO. RETURN.
01700
01800 GBUF: ; BUFFER IS FULL; GET A NEW ONE.
01900 MOVNI T,LOBUFS ;LENGTH OF A BUFFER.
02000 PUSHJ P,GFS ;GET SOME FREE STORAGE(WHILE IT LASTS!)
02100 HRLI T,400 ;MAKE BYTE PTR.
02200 MOVEM T,RELPTR(T1) ;PTR. FOR RELOCATION BITS.
02300 MOVEI T2,LOBUFS/12+2(T) ;LEAVE ROOM FOR REL. BITS
02400 HRRM T2,EMPTR(T1) ;DATA PTR.
02500 HRRZM T,@OBPTR(T1) ;FIX UP FORWARD LINKS.
02600 HRRZM T,OBPTR(T1)
02700 SETZM @OBPTR(T1)
02800 MOVNI LOBUFS-LOBUFS/12-3
02900 MOVEM BUFCNT(T1) ;SET UP WORD COUNT.
03000 POPJ P,
03100
03200 EMPTR: POINT 36,0,35 ;DATA OUTPUT POINTERS.
03300 EMIPTR: POINT 36,0,35
03400 EMVPTR: POINT 36,0,35
03500 RELPTR: POINT 4,0 ;RELOC. BITS PTRS.
03600 RELIPT: POINT 4,0
03700 RELVPT: POINT 4,0
03800
03900 OBPTR: BLOCK 3 ;PTR. TO FIRST WORD OF CURRENT BUFFER FOR
04000 ; USE IN FIXING UP FORWARD LINKS.
04100 BUFCNT: BLOCK 3 ;WORD COUNTS FOR BUFFERS.
04200
04300 FCBUF: 0 ;PTR. TO FIRST BUFFER IN EACH CHAIN.
04400 FICBUF: 0
04500 FVCBUF: 0
04600
04700 GFS: ADD T,JOBSYM ;DECREMENT BOTTOM OF FREE STORAGE.
04800 HRRZ JOBFF
04900 CAIL (T) ;ROOM LEFT ?
05000 ERROR (STORAGE FULL) ;NO.
05100 MOVEM T,JOBSYM
05200 POPJ P,
00100 ;THIS HERE IS THE COMPILER !
00200 ; RECURSIVE EXPRESSION ANALYZER.
00300
00400 SEXPR: PUSHJ P,SCAN
00500 EXPR: PUSHJ P,TERM ;<EXPR> = <TERM> ! <TERM><ADDOP><EXPR>
00600 EXPR1: TLNE A,DF ;A DELIMITER NEXT ?
00700 TLNN A,ADDBIT ;YES. AN ADD OR SUBTRACT OP. ?
00800 POPJ P, ;NO.
00900 PUSH P,A ;YES. LOOK FOR ANOTHER TERM.
01000 PUSHJ P,STERM ;THIS IS ITERATIVE INSTEAD OF
01100 ; RECURSIVE IN ORDER TO PROCESS FROM LEFT TO
01200 EXCH A,(P) ; RIGHT.
01300 PUSHJ P,(A) ;CALL APPROPRIATE GENERATOR.
01400 POP P,A
01500 JRST EXPR1
01600
01700 STERM: PUSHJ P,SCANV
01800 TERM: PUSHJ P,FACTOR ;<TERM>=<FACTOR>!<FACTOR><MULOP><FACT.>
01900 TERM1: TLNE A,DF ;A DELIMITER NEXT ?
02000 TLNN A,MULBIT ;YES. A MULTIPLY OR DIVIDE OP ?
02100 POPJ P, ;NO.
02200 PUSH P,A
02300 PUSHJ P,SFACTOR
02400 EXCH A,(P)
02500 PUSHJ P,(A)
02600 POP P,A
02700 JRST TERM1
02800
02900 SFACTOR:PUSHJ P,SCANV
03000 FACTOR: JRST PRIMARY ;GOOD ENOUGH FOR NOW ...
03100
03200 SPRIM: PUSHJ P,SCAN
03300 PRIMARY:
03400 JUMPE A,UDIERR ;STILL UNDEFINED ?
03500 TLNN A,DF ;IS IT A SPECIAL CHAR. ?
03600 JRST PRIM3 ;NO.
00100 PRIM2: CAMN A,MINV ;UNARY MINUS ?
00200 JRST PRUMIN ;YES.
00300 CAME A,LPARV ;NO. IT BETTER BE A (.
00400 ERROR (ILLEGAL PRIMARY.)
00500 PUSHJ P,SEXPR ;SCAN AN EXPRESSION.
00600 CAME A,RPARV ;LOOK FOR MATCHING PAREN.
00700 ERROR (MISSING RIGHT PAREN.)
00800 JRST SCAN ;SCAN AND RETURN.
00900
01000 PRUMIN: PUSHJ P,SPRIM ;UNARY MINUS; SCAN A PRIMARY.
01100 PUSH P,A
01200 PUSHJ P,UMGEN ;CALL GENERATOR.
01300 JRST POPAJ ;RESTORE A AND RETURN.
01400
01500 PRIM3: TLNN A,FUNBIT ;THE NAME OF A FUNCTION ?
01600 JRST SVRBL ;NO.
01700 PRFUN: PUSHJ P,FUNCAL ;COMPILE THE FUNCTION CALL.
01800 PUSHJ P,MRKAC0 ;MARK AC0 FULL (VALUE OF FUNCTION).
01900 JRST SCAN ;RETURN.
02000
02100 SVRBL: TLNN A,VRBLBT!SWVBT!NUMFLG!FOOBIT ;SHOULD BE A VARIABLE,ARRAY NAME,NUMBER OR FOO SYM.
02200 ERROR (ILLEGAL PRIMARY)
02300 TLNE A,VRBLBT!NUMFLG!FOOBIT ;IS IT AN ARRAY NAME ?
02400 JRST SVRBL2 ;NO.
02500 HRR A,(A) ;YES. GET R. HALF OF GOOD BITS.
02600 SUBI A,2 ;MAKE IT POINT TO ARRAY[-2].
02700 SVRBL2: PUSH OSP,A ;MAY BE AN ASN. STMT....
02800 TLNE A,NUMFLG+SWVBT ;IF IT IS A NUMBER, IT CAN'T BE
02900 JRST SCAN ;LEFT PART OF ASN. STMT.
03000 SVRBL1: PUSHJ P,SCAN ;GET LEFT ARROW,IF ANY.
03100 CAME A,LARV ;IT IS ONE, ISN'T IT ?
03200 LAROW: POPJ P, ;NOPE. JUST A GARDEN VARIETY VARIABLE.
03300 PUSHJ P,ASTMT1 ;YES. COMPILE IT.
03400 PUSHJ P,MRKAC ;SINCE ITS A PRIMARY, REMEMBER ITS
03500 JRST POPAJ ;VALUE, THEN RETURN.
03600 ASTMT1: ;; COMPILE ASSIGNMENT STMT...
03700 PUSHJ P,SEXPR ;COMPILE RIGHT PART OF STMT.
03800 EXCH A,(P) ;SAVE 'A' UNDERNEATH RETURN ADR.
03900 PUSH P,A
04000 JRST ASNGEN ;GENERATE THE STORE.
00100 ; PROCESS A FUNCTION CALL.
00200
00300 FUNCAL: PUSH P,RLOC ;SAVE R-TIME CODE LOC. CTR.
00400 HRRZ B,(A) ;GET PTR. TO PARAMETER DESCRIPTORS.
00500 PUSH P,B ;PTR. TO SYMTABLE ENTRY.
00600 PUSH OSP,(B) ;PLACE CALLING INSTR. ON OPND. STK.
00700 PUSH P,[POINT 6,0,35] ;MAKE A PTR. TO THE BYTES
00800 HRRM B,(P) ; OF THE PARAMETER DESRIPTION.
00900 ILDB T,(P) ;GET PARAMTER COUNT.
01000 PUSH P,T
01100 JUMPE T,FNOPR ;IF NO PARAMS., CALL GENERATOR.
01200 PUSHJ P,SCAN ;SWALLOW LEFT PAREN.
01300 CAME A,LPARV ;I HATE PEOPLE WHO DO THIS.
01400 ERROR (MISSING LEFT PAREN.)
01500 PUSHJ P,SCAN ;SCAN FIRST PARAM.
01600 FUNC4: PUSH P,A
01700 FUNC1: ILDB T,-2(P) ;GET NEXT PARAM. DESCRIPTOR.
01800 CAIN T,FDPARB ;IS IT A DUMMY PARAM. ?
01900 JRST FDPAR ;YES.
02000 CAIN T,FDPARC ;OR A TYPE 2 DUMMY ?
02100 JRST FDPAR2 ;YES.
02200 POP P,A ;NO.
02300 JUMPE T,FLPAR ;IF =0,NO MORE PARAMS.
02400 CAME A,RPARV ;NO PARENTHESES OR COMMAS HERE, PLEASE.
02500 CAMN A,COMMAV
02600 ERROR (MISSING PARAMETER)
02700 CAIN T,FAOPAR ;MUST THIS PARAM. BE AN ARRAY NAME ?
02800 JRST FAPAR ;YES.
02900 PUSHJ P,EXPR ;NO, LET IT BE AN EXPRESSION.
03000 FUNC2: CAMN A,COMMAV ;IS IT A COMMA ?
03100 FUNC3: PUSHJ P,SCAN ;YES, ALTHOUGH WE DONT REALLY CARE.
03200 JRST FUNC4
03300
03400 FLPAR: CAME A,RPARV ;LAST PARAM. IS FOLLOWED BY ).
03500 ERROR (MISSING RIGHT PAREN.) ; ... OR ELSE.
03600 FNOPR: PUSHJ P,GFUNC ;CALL GENERATORS.
03700 ILDB A,-1(P) ;GET NO. OF AC CONTAINING RESULT.
03800 SUB P,[XWD 4,4] ;FORGET ABOUT THINGS IN STACK.
03900 POPJ P,
04000
04100 FAPAR: ;PARAMETER IS NAME OF FUNCTION ARRAY.
04200 PUSHJ P,GAPAR ;CALL GENERATOR.
04300 PUSHJ P,SCAN
04400 JRST FUNC2
04500
04600 FDPAR: PUSHJ P,GDPAR ;GENERATE A DUMMY PARAM.
04700 JRST FUNC1
04800 FDPAR2: PUSH OSP,[0] ;EMIT A DUMMY PARAM., BUT WITHOUT
04900 JRST FUNC1 ;ANY INSTR. TO ZERO IT AT I-TIME.
00100 ; HERE ARE THE GLORIOUS, SUPER-INTELLIGENT, SCHIZOPHRENIC
00200 ; CODE GENERATORS. LOOK UPON THEM AND BE AMAZED.
00300
00400 MULGEN: SKIPA T,[FMP] ;GENERATE A MULTIPLY.
00500 ADDGEN: MOVSI T,(<FAD>) ;SEE THE STUPID FAIL !
00600 PUSH P,T
00700 PUSHJ P,GGET1 ;GET ONE OPERAND IN AN AC.
00800 GEN1: POP P,C ;RECOVER THE OPCODE.
00900 GEN2: PUSHJ P,EMINST ;EMIT THE INSTRUCTION.
01000 JRST MRKAC ;MARK THE AC FULL AND RETURN.
01100
01200 DIVGEN: SKIPA T,[FDV] ;GENERATE A DIVIDE ...
01300 SUBGEN: MOVSI T,(<FSB>) ; .. OR A SUBTRACT.
01400 PUSH P,T
01500 PUSHJ P,GGET2 ;GET FIRST OPERAND IN AN AC.
01600 JRST GEN1
01700
01800 UMGEN: PUSHJ P,GMURKA ;UNARY MINUS. GET THE OPERAND.
01900 PUSH P,E
02000 PUSHJ P,GETAC ;GET A FREE AC.
02100 POP P,B ;BRING BACK AC ADDRESS.
02200 MOVSI C,(<MOVN>) ;EMIT GOOD INSTRUCTION.
02300 JRST GEN2
02400
02500 MULOP←←MULGEN
02600 ADDOP←←ADDGEN
02700 SUBOP←←SUBGEN
02800 DIVOP←←DIVGEN
02900
03000 ASNGEN: ;COMPILE STORE FOR ASIGNMENT STMT.
03100 ASNOP: PUSH P,-1(OSP) ;SAVE PTR. TO GOOD BITS OF VRBL.
03200 PUSHJ P,GMURK ;GET EXPR. AND LEFT-PART VARIABLE.
03300 EXCH D,E ;GET THEM IN RIGHT ORDER.
03400 PUSHJ P,GG2 ;GET EXPR. IN AN AC.
03500 POP P,T ;RECOVER PTR. TO VRBL. GOOD BITS WORD...
03600 MOVE H
03700 LSH =35-PRVBT ;PUT R-TIME FLAG IN RIGHT POSITION...
03800 TLNN B,GPBIT ;IF NOT A P-SYMBOL,
03900 ORM (T) ;SET R-TIME BIT CORRECTLY.
04000 MOVSI C,(<MOVEM>) ;EMIT A MOVEM TO STORE VALUE OF EXPR.
04100 JRST EMINST
04200
00100 ; HA! I BET YOU THOUGHT WE WERE DONE, DIDN'T YOU ?
00200
00300 ; WELL, HERE BEGINS AN INFINITE REGRESSION OF
00400 ; CLEVER ,GRUBBY ROUTINES WHICH DO THE
00500 ; DIRTY WORK FOR THE GENERATORS.
00600
00700 ; GPONDER REMOVES THE TOP THING FROM THE OPERAND STACK,
00800 ; LOVINGLY PATS ITS MAGIC BITS INTO STANDARD FORMAT,
00900 ; AND SETS A FLAG INDICATING WHETHER IT IS AN
01000 ; R-TIME VARIABLE OR NOT.
01100
01200 GPONDER: MOVEI H,0 ;RESET R-TIME VARIABLE FLAG.
01300 GPOND1: POP OSP,T ;GET TOP THING.
01400 TLNE T,FOOBIT ;IS IT A FOO-SYMBOL?
01500 JRST GPFOO ;YES.
01600 TLNE T,NUMFLG ;A NUMBER ?
01700 POPJ P, ;YES. WE ARE DONE.
01800 TLNE T,SRACBT+RVBT ;AN R-TIME AC OR VARIABLE ?
01900 MOVEI H,1 ;YES. SET R-TIME FLAG.
02000 TLNE T,SRACBT ;AN R-TIME AC ?
02100 SETZM RACS(T) ;YES. MARK IT FREE.
02200 TLNE T,SIACBT ;(SAME FOR I-TIME AC).
02300 SETZM IACS(T)
02400 TLNE T,VRBLBT ;A VARIABLE ?
02500 HRR T,(T) ;YES. GET RT. HALF GOOD BITS.
02600 POPJ P,
02700 GPFOO: TRZE T,400000 ;IS IT A P-SYMBOL?
02800 JRST GPONP ;YES.
02900 GPONU: MOVEI H,1 ;REFERS TO A UINIT GENERATOR; SET FLG.
03000 HRRZS T ;GET NO. OF UNIT GEN.
03100 CAMLE T,UOPTR ;NO FORWARD REFERENCES TO UNIT GEN.
03200 ERROR (FORWARD REF. TO UNIT GENERATOR)
03300 MOVE T,UOTBL(T) ;GET ADDRESS OF ITS OUTPUT CELL.
03400 POPJ P,
03500
03600 GPONP:
03700 ADDI T,PBASE ;BASE OF PARAM. ARRAY.
03800 HRLI T,GPBIT ;MARK AS P-SYMBOL.
03900 POPJ P,
04000
00100 ; GMURK CLEVERLY GPONDERS THE TOP TWO OPERANDS,
00200 ; AND IF ONE OF THEM IS AN R-TIME VARIABLE
00300 ; AND THE OTHER IS AN I-TIME AC OR A P-SYMBOL, IT STORES
00400 ; THE LATTER WHERE IT WILL BE SAFE UNTIL R-TIME.
00500
00600 GMURKA: MOVEI H,0
00700 GMURK1: TDZA T,T ;PROCESS ONLY TOP STACK ELEMENT.
00800 GMURK: PUSHJ P,GPONDER ;GPONDER THE FIRST OPERAND.
00900 PUSH P,T ;SAVE IT
01000 PUSHJ P,GPOND1 ;NOW THE SECOND.
01100 POP P,D ;PUT THEM BOTH IN SOME SAFE ACCUMULATORS.
01200 MOVE E,T
01300 SKIPN H ;IS EITHER ONE AN R-TIME VARIABLE ?
01400 POPJ P, ;NO.
01500 TLNE E,SIACBT+GPBIT ;AN I-TIME AC OR A P-SYMBOL ?
01600 JRST GM2 ;YES.
01700 TLNN D,SIACBT+GPBIT ;HOW ABOUT THIS ONE ?
01800 POPJ P, ;HE ISN'T, EITHER. RETURN.
01900 SKIPA F,[EXP D] ;BAGBITING MACROX.
02000 GM2: MOVEI F,E ;SEE THE TWO HEADED MONSTER.
02100 MOVE A,(F) ;GET THE RELEVANT THING.
02200 TLNE A,GPBIT ;A P-SYMBOL, OR AN I-TIME AC ?
02300 JRST GM3 ; A P-SYMBOL.
02400 MOVE B,VLOC ;STORE IT IN VARIABLE AREA.
02500 GM3B: MOVEM B,(F) ;CHANGE THE OPERAND INDICATOR.
02600 MOVE C,[MOVEM EMICDI] ;EMIT THE STORE INSTRUCTION.
02700 PUSHJ P,EMINST
02800 JRST EMDV ;MAKE APLACE IN THE VARIABLES FOR IT.
02900
03000 GM3: SKIPN T1,(A) ;HAS THE PARAMETER ALREADY BEEN
03100 JRST GM3A ; PUT IN VAR. AREA ?
03200 MOVEM T1,(F) ;YES. CHANGE POINTER.
03300 POPJ P,
03400
03500 GM3A: PUSHJ P,GETIAC ;FIND FREE I-TIME AC.
03600 MOVE B,(F)
03700 MOVE T,VLOC ;GET VAR. LOC. CTR.
03800 TLO T,GPBIT
03900 MOVEM T,(B) ;ENTER IN PARAMTER TABLE.
04000 MOVE C,[MOVE EMICDI] ;EMIT INSTR. TO
04100 PUSHJ P,EMINST ;PICK UP THE PARAMETER.
04200 MOVE B,VLOC ;GET LOC. AGAIN...
04300 TLO B,GPBIT ;MARK AS A P-SYMBOL.
04400 JRST GM3B ;NOW STORE THE PARAMETER IN VAR. AREA.
04500
00100 ; STILL MORE KLUGES. PAUSE TO GET YOUR BREATH NOW.
00200
00300 ;GGET1 ARRANGES TO HAVE ONE OF THE TOP TWO OPERANDS
00400 ; IN AN AC. IT RETURNS IN 'A' THE ADDRESS OF THAT AC, AND
00500 ; IN 'B' THE ADDRESS OF THE OTHER OPERAND, WITH RELOCATION
00600 ; BITS IN LEFT HALF.
00700
00800 GGET1: PUSHJ P,GMURK ;PROCESS TOP TWO OPERANDS.
00900 TLNN D,SIACBT+SRACBT ;IS FIRST ONE IN AN AC ?
01000 JRST GG2 ;NO.
01100 MOVE A,D ;YES. WE ARE DONE.
01200 MOVE B,E
01300 POPJ P,
01400 GGET2: PUSHJ P,GMURK ;GGET2 GETS SECOND OPERAND IN AN AC.
01500 GG2: MOVE A,E ;PUT OPERAND IN A.
01600 TLNE A,SIACBT+SRACBT ;IS IT ALREADY IN AN AC ?
01700 JRST GL2A ;YES. WIN BIG.
01800 TLNE D,SIACBT+SRACBT ;HOW ABOUT OTHER OP. ?
01900 SETOM @ACTB3(H) ;AN AC... MARK IT FULL TEMPORARILY.
02000 PUSHJ P,GETAC ;GET A FREE AC OF THE APPROPRIATE KIND.
02100 MOVE B,E ;LOAD SECOND OPERAND INTO IT.
02200 MOVSI C,(<MOVE>) ;EMIT LOAD INSTR.
02300 PUSHJ P,EMINST
02400 TLNE D,SIACBT+SRACBT ;IF OTHER OP. IS IN AN AC,
02500 SETZM @ACTB3(H) ;MARK IT FREE NOW.
02600 GL2A: MOVE B,D ;PUT OTHER OP IN B.
02700 POPJ P,
02800
02900 ; EMINST IS THE INSTRUCTION EMITTING ROUTINE. CALL IT
03000 ; WITH AC IN A,THE ADDRESS (+ RELOC. BITS) IN B, AND
03100 ; OPCODE IN C. IF RIGHT HALF OF C IS NON-ZERO, IT IS THE
03200 ; ADDRESS OF THE APPROPRIATE BUFFER EMITTING ROUTINE;
03300 ; OTHERWISE THE INSTR. IS PLACED IN THE I-TIME
03400 ; OR R-TIME BUFFERS ACCORDING TO THE STATE OF THE FLAG IN H.
03500
03600 EMINST: PUSH P,A ;SAVE IT.
03700 HLL A,C ;ASSEMBLE INSTRUCTION IN A.
03800 DPB A,[POINT 4,A,12] ;PUT IN AC FIELD.
03900 HRR A,B ;ALSO ADDRESS.
04000 TLZE B,FPARBT ;IS ADDR. A FORMAL PARAMETER ?
04100 TLO A,20+RA ;YES. ADD INDIRECT BIT AND INDEX.
04200 HLRZS B ;PUT RELOC. BITS FOR ADDRESS IN RIGHT HALF OF B.
04300 PUSH P,[EXP EMIN2] ;RETURN ADDRESS.
04400 TRNE C,-1 ;RH OF C =0 ?
04500 JRST (C) ;NO.
04600 JRST @EMITB(H)
04700 POPAJ: ;A USEFUL ENTRY POINT.
04800 EMIN2: POP P,A
04900 POPJ P,
05000 EMITB: EMICDI
05100 EMCDI
05200 ACTB3: XWD D,IACS
05300 XWD D,RACS
00100 ;GETAC SEARCHES FOR A FREE AC, EITHER I-TIME OR
00200 ; R-TIME, AS INDICATED BY THE STATE OF THE FLAG IN H.
00300
00400 GETAC: SKIPE H ;ARE WE EMITTING R-TIME CODE ?
00500 GETRAC: SKIPA T3,[XWD SRACBT+A,RACS] ;YES, FIND A R-TIME AC.
00600 GETIAC: MOVE T3,[XWD SIACBT+A,IACS] ;FIND AN I-TIME AC.
00700 MOVE A,[XWD -NACS,NFACS] ;CONSIDER ONLY AC'S 4-14
00800 TRNE FL,CSBRBT ; ..UNLESS WE'RE COMPILING A FUNCTION..
00900 MOVE A,[XWD -NFACS,0] ;WE ARE. CONSIDER ONLY 0-3.
01000 SKIPE @T3 ;INDIRECT ADDRESSING IS GOOD FOR YOU.
01100 AOBJN A,.-1 ;NOT FREE. TRY FOR NEXT ONE.
01200 JUMPLE A,GETAC3 ;DID WE FIND ONE ?
01300 PUSHJ P,GETAC2 ;NO. STORE ONE.
01400 GETAC3: HRLI A,SRACBT ;YES. PUT IN APPROPRIATE FLAG BITS.
01500 TLNN T3,SRACBT ;OOPS, IT'S AN I-TIME AC.
01600 HRLI A, SIACBT
01700 POPJ P,
01800
01900 GETAC2: SUBI A,1 ;STORE HIGHEST AC.
02000
02100 GSVAC: MOVE T,@T3 ;FIND OUT WHO'S IN HIM.
02200 MOVE B,VLOC ;GET LOC. TO STORE HIM IN.
02300 MOVEM B,(T) ;FIX UP HIS STACK ENTRY.
02400 SETZM @T3 ;MARK HIM EMPTY.
02500 MOVSI C,(<MOVEM>) ;EMIT THE STORE INST.
02600 PUSHJ P,EMINST
02700 JRST EMDV ;LEAVE A PLACE IN VARIABLES AREA.
02800
02900 ;MRKAC PUTS THE AC SYMBOL IN A BACK ON THE STACK AND MARKS
03000 ; THE CORRESPONDING AC AS FULL.
03100
03200 MRKAC0: IOR A,MRKTAB(H) ;MARK IAC 1 OR RAC 1 FULL.
03300
03400 MRKAC: PUSH OSP,A ;PUT IT ON STACK.
03500 TLNN A,SRACBT ;AN R-TIME AC?
03600 HRRZM OSP,IACS(A) ;NO, MARK CORRESPONDING I-TIME AC FULL.
03700 TLNE A,SRACBT
03800 HRRZM OSP, RACS(A)
03900 CPOPJ: POPJ P,
04000
04100 MRKTAB: XWD SIACBT,0 ;DESCRIPTOR FOR I-TIME AC NO. 1
04200 XWD SRACBT,0 ;R-TIME AC 1.
04300
00100 ;; MORE GENERATORS.
00200
00300 GAPAR: ;; HANDLE A PARAMETER WHICH IS AN ARRAY NAME.
00400 TLNE A,SWVBT ;IS IT AN ARRAY IDENTIFIER OR
00500 HRR A,(A)
00600 TLNE A,FPARBT+SWVBT ; A FORMAL PARAMETER ?
00700 JRST GAPR1 ;YES.
00800 TLNE A,FOOBIT ;BETTER BE A FOO-SYMBOL, THEN....
00900 TRZN A,400000 ;FURTHERMORE, IT MUST BE A P-SYM.
01000 ERROR(IMPROPER ARRAY PARAMETER)
01100 PUSH P,A ;SAVE P NO.
01200 PUSHJ P,GETIAC ;FIND FREE I-TIME AC.
01300 POP P,B
01400 ADDI B,PBASE ;CALC. ADDR. OF P-SYMBOL.
01500 MOVE C,[MOVE EMICDI] ;EMIT MOVE AC,P-SYMBOL TO THE
01600 PUSHJ P,EMINST ;I-TIME CODE STREAM.
01700 HRLI A,(<MOVEM>) ;NOW A MOVEM AC, INTO THE PARAMETER
01800 DPB A,[POINT 4,A,12] ;LOCATION.
01900 TRZA A,-1 ;CLEAR ADDRESS FIELD.
02000 GDPAR: MOVSI A,(<SETZM>) ;PARAM. LIST AT I-TIME.
02100 PUSH OSP,ILOC ;PUT ARRAY MARKER IN OPERAND
02200 MOVSI T,SWVBT+FPARBT ;STACK SO A FIXUP CAN BE EMITTED TO
02300 IORM T,(OSP) ;THE UPCOMMING HRRM WHEN THE PARAMETERS
02400 MOVEI B,0 ;NO RELOCATION, PLEASE.
02500 JRST EMICDI ;EMIT HRRM TO STORE ARRAY LOC. INTO
02600 ;PARAMETER CELL, AND RETURN.
02700 GAPR1: PUSH OSP,A ;PLACE IN OPERAND STACK.
02800 POPJ P,
00100 GFUNC: ;; GENERATE A FUNCTION CALL.
00200 MOVE A,@-3(P) ;PICK UP THE CALLING INSTR. FOR THE FUNCTION.
00300 MOVE D,RLOC ;DECIDE WHETHER CALL IS TO BE IN
00400 MOVEI H,0 ;R-TIME OR I-TIME CODE.
00500 TLZN A,20 ;IND. BIT IN INSTR. SAYS R-TIME ALWAYS.
00600 CAME D,-4(P) ;ALSO R-TIME IF ANY R-TIME PARAMETERS
00700 MOVEI H,1 ;HAVE BEEN COMPILED.
00800 GFUNC8: MOVE T3,ACTB1(H)
00900 MOVSI A,-NFACS ;PREPARE TO SEARCH AC'S 0-4.
01000 SKIPN T,@T3 ;IS THIS ONE IN USE ?
01100 AOBJN A,.-1 ;NO.
01200 JUMPG A,GFUNC6 ;DID WE FIND A BUSY ONE ?
01300 PUSHJ P,GSVAC ;YES. SAVE IT.
01400 JRST GFUNC8
01500 GFUNC6: PUSH P,-1(P) ;PUT PAR. COUNT ON STACK.
01600 HRRZM P,TEMP1# ;SAVE LOC. OF COUNT.
01700 GFUNC5: SOSGE @TEMP1 ;MORE PARAMS ?
01800 JRST GFUNC4 ;NO.
01900 PUSHJ P,GMURK1 ;GET A PARAM.
02000 TLNN E,SWVBT
02100 TLNN E,FPARBT ;IS IT A FORMAL PARAMETER ?
02200 JRST GFUNC7 ;NO, THANK GOD.
02300 MOVE A,E ;SIGH. THE PRICE OF HONESTY ...
02400 HRLI A,(<MOVE (RA)>) ;EMIT CODE TO PICK UP THE
02500 MOVEI B,0 ;PARAM. PTR. AND PUT IT IN THE
02600 PUSHJ P,@EMITB(H) ;CURRENT CALLING SEQUENCE.
02700 MOVE E,ILOC(H) ;SAVE ILOC OR RLOC FOR LATER FIXUP.
02800 TLO E,FPARBT ;MIGHT AS WELL USE THIS BIT...
02900 MOVSI A,(<MOVEM>) ;NOW THE SECOND INSTR....
03000 PUSHJ P,@EMITB(H)
03100 GFUNC7: PUSH P,E ;SAVE IT.
03200 JRST GFUNC5 ;GET ANOTHER.
03300 GFUNC4: POP OSP,A ;NOW EMIT THE CALLING INSTR.
03400 GFUNC2: LDB B,[POINT 4,A,17] ;RELOC. BITS.
03500 TLZ A,37
03600 TLZE A,SWVBT ;IS IT AN ARRAY NAME ?
03700 TLO A,INSXR ;YES. ADD INDEX FIELD.
03800 GFUNC3: PUSHJ P,@EMITB(H) ;
03900 POP P,A ;GET PARAM. FROM STACK.
04000 JUMPL A,CPOPJ ;IF IT'S THE MARK, RETURN.
04100 TLZN A,FPARBT ;IS IT A FORMAL PARAMETER ?
04200 JRST GFUNC2 ;NO. EMIT IT.
04300 MOVEI B,.FXBTS ;YES. EMIT A FIXUP TO THE RIGHT INSTRUCTION.
04400 TLZ A,400000+LRFXBT+SWAPBT ;A REPLACEMENT FIXUP TO RT. HALF.
04500 TLO A,RRFXBT
04600 PUSHJ P,@EMITB2(H) ;EMIT IT TO I-TIME OR R-TIME BUFER.
04700 MOVEI B,0 ;NOW RESERVE SPACE FOR THE PARAM.
04800 JRST GFUNC3
04900 EMITB2: EMICD
05000 EMCD
05100 ACTB1: XWD SIACBT+A,IACS ;PTR. TO IACS,INDEXED BY B.
05200 XWD SRACBT+A,RACS
00100 ;; UTILITY RUOTINE TO ENTER AN ITEM IN THE MAIN SYMBOL TAB.
00200
00300 GETNAM: PUSHJ P,SCANV ;SCAN AN IDENTIFIER.
00400 GETNM1: AOS T,(P) ;TO SKIP PARAM ON RETURN.
00500 JUMPE A,GNM2 ;SHOULD BE UNDEFINED...
00600 TLOE A,DF ;IT'S NOT. MAYBE IT'S A DELIMITER ?
00700 ERROR (MISSING IDENTIFIER)
00800 TLNN A,@-1(T) ;NO. MAYBE ALREADY RIGHT TYPE ?
00900 ERROR (MULTIPLY DEFINED SYMBOL)
01000 SKIPGE -1(T) ;AH, IT IS. SHOULD WE REENTER IT ?
01100 POPJ P, ;NO. ITS OLD ENTRY WILL DO.
01200 GNM2: HRLZ A,-1(T) ;YES. GET TYPE BITS.
01300
01400 AENTER: HRRZ JOBFF ;GET NEXT FREE LOCATION.
01500 HRRZ B,CBNO ;GET BUCKET NO. OF THING JUST SCANNED.
01600 EXCH BUCTBL(B) ;UPDATE BUCKET HEAD.
01700 AOS B,JOBFF
01800 MOVEM -1(B) ;PUT THE LINK IN THE NEW ENTRY.
01900 MOVEM A,1(B) ;PUT THE RANDOM GOOD BITS IN.
02000 MOVE ACCUM ;GET FIRST WORD OF NAME.
02100 MOVEM (B) ;PUT IN TABLE.
02200 AOS B,JOBFF
02300 MOVEI T,ACCUM+1 ;PREPARE TO MOVE REST OF NAME.
02400 AEL1: AOS JOBFF
02500 SKIPN T1,(T) ;ANY MORE OF THE NAME ?
02600 JRST AEL2 ;NO.
02700 MOVEM T1,@JOBFF ;YES. PUT IN TABLE.
02800 CAIL T,ACCUM+2 ;UNLESS FIRST OR SECOND WORD,
02900 SETZM (T) ;ZERO WORD IN ACCUM.
03000 AOJA T,AEL1
03100 AEL2: HRRZ JOBSYM ;GET BOTTOM OF BUFFER AREA.
03200 CAMG JOBFF ;HAVE WE OVERRUN IT ?
03300 ERROR(CORE IS FULL)
03400 HRR A,B
03500 HRRZ JOBFF
03600 HRLM JOBSA
03700 POPJ P,
03800
00100 ;; INITIALIZATION OF THE COMPILER.
00200
00300 EXTERNAL JOBFF,JOBSA
00400 JOBSYM: 0
00500
00600 SCOMPA: MOVE OSP,[XWD -LOSTK,OSTK-1] ;INIT. OPERAND STACK.
00700 PUSH OSP,JOBSYM ;...SO WE CAN RESTORE IT LATER.
00800 MOVSI IRELBT ;INIT THE THREE LOCATION
00900 MOVEM ILOC ;COUNTERS (APPROPRIATE RELOCATION
01000 MOVSI RRELBT ;BITS LIVE IN LEFT HALF OF EACH).
01100 MOVEM RLOC
01200 MOVSI VRELBT
01300 MOVEM VLOC
01400 MOVEI T1,2 ;SET UP THE THREE CHAINS OF OUTPUT
01500 SCMP1: SETZM OBPTR(T1)
01600 PUSHJ P,GBUF ;BUFFERS.
01700 HRRZM T,FCBUF(T1) ;PTR. TO FIRST BUFFER OF CHAIN
01800 SOJGE T1,SCMP1 ;DO FOR ALL THREE CHAINS.
01900 SETZM IARR1 ;ZERO SOME TABLES AND STUFF.
02000 MOVE [XWD IARR1,IARR1+1]
02100 BLT IARR2-1
02200 MOVEI FL,0 ;CLEAR FLAGS.
02300 POPJ P,
02400
02500 SCOMP: PUSHJ P,SCOMPA ;INIT. THE COMPILER.
02600 MOVE [XWD IARR2-1,IARR2]
02700 BLT IARR3-1 ;ZERO REST OF TABLES.
02800 POPJ P,
00100 ;; SYNTAX ANALYZER.
00200
00300 SSTATL: PUSHJ P,SMCSCN ;SCAN NEXT NON-SEMICOLON.
00400 STATL: CAMN A,FINV ;IS IT A FINISH ?
00500 JRST ENDP1 ;YES.
00600 PUSHJ P,STAT ;NO. SCAN A STATEMENT.
00700 JRST SSTATL ;GO BACK FOR MORE.
00800
00900 SSTAT: PUSHJ P,SMCSCN
01000 STAT: MOVEI H,0 ;CLEAR 'R-TIME CODE' FLAG.
01100 JUMPGE A,STAT2 ;A DELIMITER ?
01200 TLNE A,DECLBIT ;YES. A DECLARATION ?
01300 JRST (A) ;YES. DISPATCH TO RIGHT ROUTINE.
01400 STAT2: PUSHJ P,STMT1 ;IT HAS TO BE A STMT1.
01500 STATL1: CAME A,SEMICV ;SEMICOLON AFTER EVERY STMT.,PLEASE.
01600 ERROR (MISSING SEMICOLON) ;I HATE MYSELF FOR THIS.
01700 TDZ FL,[XWD ERRFLG,EXTFLG] ;TURN OFF ERROR FLAG.
01800 POPJ P, ;END OF STATEMENT.
01900
02000 EXTD: PUSHJ P,SCAN ;"EXTERNAL" DECLARATION.
02100 CAME A,FUNV ;BETTER BE "FUNCTION".
02200 ERROR (<EXTERNAL FUNCTIONS ONLY,PLEASE.>)
02300 TRO FL,EXTFLG ;SET FLAG.
02400 JRST DFUNC
02500
02600 SSTMT1: PUSHJ P,SCAN
02700 STMT1: SKIPN A ;IS IT UNDEFINED ?
02800 ERROR (UNDEFINED IDENTIFIER)
02900 STMT1A: TLNE A,FUNBIT ;<STMT1>=<FUNCTION CALL> ! <ASN. STMT>
03000 JRST SFUNC ;A FUNCTION CALL.
03100 TLNN A,VRBLBT!FOOBIT ;BETTER BE A SIMPLE VARIABLE.
03200 ERROR (SIMPLE VARIABLE REQUIRED HERE.)
03300 PUSH OSP,A ;STACK IT.
03400 PUSHJ P,SCAN ;GET LEFT ARROW.
03500 CAME A,LARV
03600 ERROR (ILLEGAL STATEMENT)
03700 PUSHJ P,ASTMT1 ;IT'S AN ASSIGNMENT STMT. COMPILE IT.
03800 JRST POPAJ ;RESTORE A(WHICH WAS SAVED BY ASTMT)
03900 ; AND RETURN.
04000 SFUNC: PUSHJ P,FUNCAL ;COMPILE FUNCTION CALL
04100 JRST SCAN ;RETURN.
04200
04300 SMSC1:
04400 SMCSCN: PUSHJ P,SCAN ;SCAN PAST NEXT SEMICOLON.
04500 SMCS1: CAMN A,SEMICV
04600 JRST SMCSCN
04700 POPJ P,
00100
00200 ENDSTL: RELEAS DT, ;ALL DONE. RELEAS INPUT DEVICE.
00300 ENDP1:
00400 MOVEI A,0
00500 MOVEI B,.FXBTS ;PUT END MARKS IN THE BUFFERS.
00600 PUSHJ P,EMCD
00700 PUSHJ P,EMICD
00800 PUSHJ P,EMVCD
00900 POP OSP,JOBSYM ;RESTORE JOBSYM.
01000 POPJ P,
01100 EXTERNAL JOBDDT,JOBREL
01200
01300 DVRBL1: CAME A,COMMAV ;IS IT A COMMA ?
01400 JRST STATL1 ;NO. END OF DECL.
01500 DVRBL: PUSHJ P,SCAN ;GET NEXT ITEM.
01600 CAMN A,CTBL+"/" ;IS IT A "/" ?
01700 JRST DVRBL2 ;YES. DEFINE FOLLOWING VARIABLE AS R-TIME.
01800 PUSHJ P,GETNM1 ;NO. MUST BE NAME OF VARIABLE. PUT IN SYM. TABLE.
01900 XWD 400000,VRBLBT ;PARAM. TO GETNM1.
02000 DVRBL4: JUMPL A,DVRBL3 ;WAS IT ALREADY DEFINED ?
02100 AOS A,JOBFF ;NO, IT'S NEW. LEAVE WORD FOR THE VALUE.
02200 SUBI A,1 ;GET PTR. TO THAT WORD.
02300 HRRM A,(B) ;PUT IN GOOD BITS WORD (NO REL. BITS).
02400 DVRBL3: PUSHJ P,SCAN ;GET COMMA OR SEMICOLON.
02500 JRST DVRBL1 ;BACK FOR MORE.
02600
02700 DVRBL2: PUSHJ P,GETNAM ;SCAN AND ENTER NAME OF VARIABLE.
02800 XWD 400000,VRBLBT!RVBT ;INCLUDE 'R-TIME' BIT.
02900 JRST DVRBL4
00100 DF5: CAME A,COMMAV ;ARE THERE MORE DEFINITIONS ?
00200 JRST STATL1 ;NO.
00300 DFUNC: TRO FL,CSBRBT+SFOOBT ;ENTER FUNCTION DEFINING MODE.
00400 PUSHJ P,GETNAM ;GET FUNCTION NAME.
00500 EXP FUNBIT ;PARAMETER TO GETNAM.
00600 PUSH P,BUCTBL ;####$$%%$ A TEMPORARY KLUGE !!
00700 MOVE A,JOBFF ;GET FIRST FREE STORAGE LOC.
00800 HRRM A,(B) ;MAKE GOOD BITS WORD POINT THERE.
00900 HRLI A,600 ;MAKE A INTO A BYTE POINTER.
01000 PUSH P,A
01100 PUSH P,A
01200 IBP (P) ;THIS POINTER IS FOR PARAMETER DESCRIPTORS.
01300 HRLI A,400000+LRFXBT+RRFXBT ;NOW EMIT FIXUP TO THE
01400 ;LOCATION IN THE SYM. TABLE WHICH WILL
01500 MOVEI B,.FXBTS ;CONTAIN THE CALLING INSTR. FOR THE
01600 ; FUNCTION, SO IT CAN BE UPDATED AT
01700 PUSHJ P,EMICD ;LOAD TIME WITH THE RELOCATED ADDRESS OF THE FUNCTION.
01800 ADDI A,5 ;LEAVE ENOUGH ROOM FOR 22 PARAMETER
01900 HRRZM A,JOBFF ;DESCRIPTORS.
02000 TRNN FL,EXTFLG ;IS IT AN EXTERNAL FUNCTION ?
02100 SKIPA A,ILOC ;NO. ADDRESS IS IN ILOC.
02200 PUSHJ P,SYMSCH ;YES. FIND STARTING ADDRESS.
02300 TLO A,(<JSA RA,>) ;MAKE INTO A CALLING INSTR.
02400 MOVEM A,@-1(P) ;PLACE IN SYM. TABLE.
02500 LDB B,[POINT 4,A,17] ;GET THE RELOCATION BITS.
02600 TLZ A,17 ;TURN THEM OFF IN THE INSTRUCTION WORD.
02700 PUSHJ P,EMICD ;EMIT AS VALUE OF ABOVE FIXUP.
02800 PUSH P,[-1] ;INIT. THE PARAMETER COUNT.
02900 PUSHJ P,SCAN ;LOOK AT NEXT THING.
03000 CAME A,LPARV ;A ( ?
03100 JRST DFNOPR ;NO. THERE ARE NO PARAMETERS.
03200 DF2: PUSHJ P,SCAN ;SCAN A PARAMETER.
03300 CAME A,ARRV ;IS IT AN ARRAY NAME ?
03400 JRST DF2A ;NO.
03500 TRO FL,ARRFLG ;YUP. SET FLAG AND GET NAME OF
03600 JRST DF2 ;PARAM.
00100 DF2A: TLNE A,DF+NUMFLG
00200 ERROR (ILLEGAL FORMAL PARAMETER)
00300 AOS A,(P) ;INCREMENT PARAMETER COUNT.
00400 HRLI A,FPARBT!VRBLBT ;MAKE A INTO FORMAL PARAM. INDICATOR
00500 PUSHJ P,AENTER ; AND ENTER THE SYMBOL.
00600 MOVEI 2 ;PUT 'ORDINARY' FLAG IN THE PARAMETER
00700 TRZE FL,ARRFLG ;AN ARRAY NAME PARAM. ?
00800 MOVEI 1 ;YES. USE RIGHT DESCRIPTOR BIT.
00900 IDPB -1(P) ;DESCRIPTOR FOR THIS PARAM.
01000 PUSHJ P,SCAN
01100 CAMN A,COMMAV ;A COMMA ?
01200 JRST DF2 ;YES LOOK FOR MORE PARAMETERS.
01300 CAME A,RPARV ;IT BETTER BE A ).
01400 ERROR (MISSING RIGHT PAREN.)
01500 PUSHJ P,SCAN ;GET THE =.
01600 MOVEI B,0 ;FLAG END OF PARAMETER DESCRIPTORS.
01700 IDPB B,-1(P)
01800 DFNOPR: TRNE FL,EXTFLG ;IS THIS AN EXTERNAL FUNCTION ?
01900 JRST DF4 ;YES. LOOK FOR NO DEFINITION.
02000 CAME A,CTBL+"="
02100 ERROR (MISSING = IN FUNCTION DEFINITION)
02200 PUSHJ P,EMICDI ;LEAVE ROOM FOR THE JSA WORD.
02300 TRZ FL,SFOOBT ;LET SCANNER SEE FOO-SYMBOLS AGAIN.
02400 PUSHJ P,SEXPR ;SCAN AN EXPRESSION.
02500 DF4: PUSH P,A
02600 TRNE FL,EXTFLG ;AN EXTERNAL ?
02700 SKIPA E,[XWD SIACBT,0] ;YES. RESULT ALWAYS IN 0.
02800 PUSHJ P,GMURK1 ;GET IT OFF STACK.
02900 PUSHJ P,GG2 ;MAKE SURE ITS IN AN AC.
03000 IDPB A,-2(P) ;TELL UNIVERSE WHICH AC .
03100 AOS B,-1(P) ;ADJUST PARAMETER COUNT.
03200 IDPB B,-3(P) ;PUT IN SYM. TABLE.
03300 MOVEI A,RA ;EMIT RETURN INSTR.
03400 MOVSI C,(<JRA RA,(RA)>)
03500 TRNN FL,EXTFLG ;...UNLESS THIS IS AN EXTERNAL.
03600 PUSHJ P,EMINST
03700 AOS A,-2(P) ;FIND TOP OF PARAM. DESC. STRING.
03800 HRRZM A,JOBFF ;RESET FREE STORAGE.
03900 HRLM A,JOBSA
04000 POP P,A
04100 SUB P,[XWD 3,3] ;FORGET JUNK IN STACK.
04200 POP P,BUCTBL ;##$$%$# MORE OF THAT KLUGE !!!
04300 TRZ FL,CSBRBT+SFOOBT ;LEAVE FUNCTION DEFINING MODE.
04400 JRST DF5 ;ALL DONE.
00100 ;; MORE SYNTAX ANALYZER. COMPILE AN INSTRUMENT DEFINITION.
00200
00300 CINS: PUSHJ P,GETNAM ;GET NAME OF INSTRUMENT.
00400 EXP INSBIT ;PARAMETER TO GETNAM.
00500 AOS A,JOBFF ;GET PLACE FOR MORE GOOD BITS..
00600 SUBI A,1
00700 HRRM A,(B) ;MAKE RANDOM BITS WORD POINT THERE.
00800 HRLI A,RRFXBT ;RIGHT HALF REPLACEMENT TYPE FIXUP.
00900 MOVEI B,.FXBTS ;EMIT FIXUP TO RIGHT HALF FROM
01000 PUSHJ P,EMICD ;FIRST LOC. OF I-TIME CODE.
01100 HRLI A,LRFXBT+SWAPBT ;FIXUP TO LEFT HALF FROM FIRST LOC.
01200 PUSHJ P,EMCD ;OF R-TIME CODE.
01300 CINS5: PUSHJ P,SCAN
01400 CINS3: PUSHJ P,SMCS1 ;IGNORE SEMICOLON, IF ANY.
01500 CAMN A,ENDV ;IS IT AN END ?
01600 JRST CINSE ;YES.
01700 TLNN A,UGBIT ;IS IT A UNIT GENERATOR CALL ?
01800 JRST CINS4 ;NOT A UNIT GENERATOR.
01900 HRRZM A,CINST1# ;SAVE IT.
02000 PUSHJ P,SCAN ;PEEK AT NEXT THING.
02100 CAMN A,CTBL+"[" ;IS IT A [ ?
02200 JRST CUG1 ;YES. UNIT GEN. HAS CONTROLLED CALLING RATE.
02300 MOVEM A,SNCHR ;NO, IT'S PROBABLY THE (. PUT IT BACK WHERE SCAN WILL SEE IT AGAIN.
02400 PUSHJ P,CINS6 ;NOW COMPILE THE CALL ON THE UNIT GEN.
02500 JRST CINS5 ;BACK FOR MORE.
02600
02700 CINS6: MOVE A,CINST1 ;RECOVER POINTER FOR USE OF FUNCAL.
02800 PUSHJ P,FUNCAL ;COMPILE CALL ON THE UNIT GEN.
02900 MOVE B,VLOC ;GET LOC. FOR OUTPUT OF UNIT GEN.
03000 AOS C,UOPTR ;INCREMENT COUNT OF UNIT GENS.
03100 MOVEM B,UOTBL(C) ;ENTER OUTPUT LOC. IN TABLE.
03200 MOVE C,[MOVEM EMCDI] ;EMIT STORE INSTRUCTION TO
03300 PUSHJ P,EMINST ;PUT OUTPUT OF UNIT GEN. AWAY.
03400 PUSHJ P,EMDV ;MAKE ROOM IN VARIABLES AREA FOR IT.
03500 MOVE T,@CINST1 ;RETRIEVE PTR. TO RANDOM GOOD BITS.
03600 SKIPN A,-1(T) ;DOES UNIT GEN. HAVE I-TIME CODE?
03700 POPJ P, ;NO.
03800 PUSHJ P,EMIABS ;YUP. EMIT THE CALLING INSTR.
03900 HRRZ A,RLOC ;AS PARAMETER, GIVE IT A PTR. TO
04000 MOVEI B,RRELBT ;JUST AFTER THE MOVEM EMITTED
04100 PUSHJ P,EMICDI ;ABOVE.
04200 POPJ P,
00100 CINS4: PUSHJ P,STMT1 ;ITS NOT A UNIT GEN. CALL.
00200 JRST CINS3 ;NO
00300 CINSE: SETZM IARR1 ;YES. ZERO THINGS.
00400 MOVE [XWD IARR1,IARR1+1]
00500 BLT IARR3-1
00600 MOVE A,[POPJ P,] ;PUT RETURN INSTR. AT END OF
00700 MOVEI B,0 ;THE I-TIME CODE.
00800 PUSHJ P,EMICDI
00900 PUSHJ P,EMCDI ;ALSO THE R-TIME CODE.
01000 CINSR1: PUSHJ P,SCAN
01100 JRST STATL1
01200
01300 ;; IF THE NAME OF A UNIT GENERATOR IS FOLLOWED BY AN
01400 ;; EXPRESSION IN SQUARE BRACKETS, THE U.G. GETS CALLED ONLY
01500 ;; EVERY N TIME STEPS, WHERE N IS THE VALUE OF THE EXPRESSION.
01600 ;; N IS RECALCULATED EVERY TIME THE U.G. IS CALLED.
01700
01800 CUG1: MOVE C,[AOSGE EMCDI] ;INSTR. TO COUNT NO. OF TIME
01900 ;STEPS TO SKIP THIS UG.
02000 MOVE B,VLOC ;GRAB LOCATION IN VARIABLE AREA
02100 ;TO HOLD COUNT OF TIME STEPS TO SKIP.
02200 MOVEI A,0 ;NO AC FIELD, PLEASE.
02300 PUSHJ P,EMINST ;EMIT THE AOSGE JUST AHEAD OF THE CODE TO CALL THE U.G.
02400 MOVE C,[SETZM EMICDI] ;ALSO EMIT AN INSTR. TO THE I-TIME
02500 MOVE B,VLOC ;CODE TO INIT. THE COUNTER LOCATION TO 0
02600 ;(SO U.G. GETS CALLED FIRST TIME).
02700 PUSHJ P,EMINST
02800 PUSH P,RLOC ;SAVE R-TIME LOC. COUNTER (FOR LATER
02900 ;FIXUP TO JRST WE ARE ABOUT TO EMIT).
03000 PUSH P,VLOC ;ALSO VARIABLE LOC., FOR LATER LOADING
03100 ; OF THE STEPS-TO-SKIP COUNTER.
03200 PUSHJ P,EMDV ;MAKE A WORD FOR IT.
03300 MOVSI A,(<JRST>) ;NOW EMIT THE JUMP AROUND THE CALL OF
03400 PUSHJ P,EMCDI ;THE U.G. !!"" N.B.: B IS 0 HERE FROM CALL ON EMDV !!
03500 PUSHJ P,SEXPR ;NOW COMPILE THE EXPRESSION IN THE BRACKETS.
03600 CAME A,CTBL+"]" ;SHOULD BE FOLLOWED BY ONE...
03700 ERROR (MISSING ])
03800 MOVEI H,1 ;INDICATE THAT WE ARE WORKING WITH R-TIME CODE...
03900 PUSHJ P,GMURK1 ;..AND GET EXPR OFF OPERAND STACK.
04000 PUSHJ P,GG2 ;NOW GET IT INTO AN AC.
04100 MOVSI C,(<FIX>) ;EMIT INSTR. TO FIX VALUE OF EXPRESSION.
04200 MOVEI B,233000 ;MAGIC NO. FOR ADDRESS OF FIX, HO HO.
04300 PUSHJ P,EMINST
04400 POP P,B ;GET LOCATION IN VARIABLE AREA OF THE STEPS-TO-SKIP COUNTER.
04500 MOVSI C,(<MOVNM>) ;AND EMIT INSTR. TO STORE NEGATIVE OF COUNT THERE.
04600 PUSHJ P,EMINST
04700 PUSHJ P,CINS6 ;NOW COMPILE CALL ON UNIT GENERATOR.
04800 POP P,A ;RECOVER LOC. OF THE JRST UNDER THE AOSGE.
04900 MOVEI B,.FXBTS ;EMIT FIXUP TO MAKE IT POINT HERE (I.E., AFTER
05000 PUSHJ P,EMCD ; END OF U.G. CALL).
05100 JRST CINS5 ;ALL DONE.
00100 ;; THE WONDERFUL, WINNING LOADER.
00200
00300 R←←1
00400 I←←2
00500 V←←3
00600
00700 LOADER: MOVE R,JOBFF ;R-TIME CODE RELOCATION CONST.
00800 HRRZ I,RLOC ;
00900 ADD I,R ;I-TIME CONST.
01000 HRRZ V,ILOC
01100 ADD V,I ;VARIABLE RELOC. CONST.
01200 MOVE T3,V
01300 ADD T3,VLOC ;PROGRAM BREAK.
01400 HRRZM T3,JOBFF
01500 HRLM T3,JOBSA ;MAKE SURE IT TAKES.
01600 HRL A,R ;ZERO THE PROGRAM AREA.
01700 HRRI A,1(R)
01800 SETZM (R)
01900 BLT A,-1(T3)
02000 MOVEI H,0 ;START WITH R-TIME CODE.
02100 LD1: ADDI H,1 ;GO TO NEXT CHAIN OF BUFFERS.
02200 CAILE H,3 ;ALL DONE ?
02300 POPJ P, ;YES.
02400 PUSH P,[LDL1] ;FAKE UP A RETURN TO LDL1.
02500 MOVE C,(H) ;INIT. THE CURRENT LOC. COUNTER.
02600 SKIPA F,FCBUF-1(H) ;PTR. TO FIRST BUF. OF CHAIN.
02700 LD2: HRRZ F,(F) ;PTR. TO NEXT BUF. OF CHAIN.
02800 HRRZ E,F ;SET UP BYTE PTR. TO RELOC. BITS.
02900 HRLI E,200
03000 HRRZI D,LOBUFS/12+2(F) ;PTR. TO DATA IN BUF.
03100 HRLI D,-<LOBUFS-LOBUFS/12-2> ;WORD COUNT.
03200 LDGW: AOBJP D,LD2 ;WORD COUNT EXHAUSTED ?
03300 MOVE (D) ;NO. PICK UP NEXT DATA WORD.
03400 ILDB A,E ;FIRST 2 REL. BITS.
03500 ILDB B,E ;LAST 2.
03600 POPJ P,
03700 LDL: PUSHJ P,LDGW ;GET NEXT WORD FROM BUFFER.
03800 LDL1: JUMPE A,LDF1 ;NO REL. GIVEN; MAY BE A FIXUP.
03900 JUMPE B,LDRST ;IF NEITHER HALF, THEN IT'S A RESET.
04000 PUSH P,CLD3 ;ANOTHER FAKE RETURN ADDRESS.
04100 LDRL1: TRNE B,1 ;RELOCATE RIGHT HALF ?
04200 ADD (A) ;YES.
04300 TRNN B,2 ;LEFT HALF ?
04400 POPJ P, ;NO.
04500 MOVSS (A)
04600 ADD (A)
04700 MOVSS (A)
04800 POPJ P,
04900 LD3: ADDM (C) ;PUT IN CORE.
05000 CLDL: AOJA C,LDL ;GET ANOTHER.
00100 ;; MORE LOADER (BUT NOT MUCH MORE, YOU WILL NOTICE !).
00200
00300 LDF1:
00400 CLD3: JUMPE B,LD3 ;PERHAPS NOT A FIXUP.
00500 JUMPE LD1 ;IT MIGHT EVEN BE AN END MARK.
00600 LDB T3,[POINT 2,0,15] ;A FIXUP. GET REL. BITS FOR PTR.
00700 DPB T3,[POINT 5,0,17]
00800 PUSH P,0
00900 JUMPG LDF2 ;IS VALUE OF FIXUP TO BE FOUND IN BUFFER ?
01000 PUSHJ P,LDGW ;YES. GET IT.
01100 PUSHJ P,LDRL1 ;PERFORM ANY INDICATED RELOCATION ON IT.
01200 SKIPA T3,0 ;MOVE RELOCATED VALUE INTO T3.
01300 LDF2: MOVE T3,C ;VALUE IS CURRENT LOCATION.
01400 POP P,0 ;BRING BACK THE POINTER WORD.
01500 TLNE SWAPBT ;SHOULD WE EXCHANGE HALVES OF THE VALUE ?
01600 MOVSS T3 ;YES.
01700 TLNE RRFXBT ;SHOULD WE REPLACE THE RIGHT HALF OF THE LOCATION ?
01800 HRRM T3,@0 ;YES. SEE THE POINTER RELOCATION HAPPEN AUTOMATICALLY !!
01900 TLNE LRFXBT ;REPLACE THE LEFT HALF ?
02000 HLLM T3,@0 ;YES.
02100 TLNN LRFXBT+RRFXBT ;IF NEITHER HALF REPLACED, THEN
02200 ADDM T3,@0 ;IT'S AN ADDITIVE FIXUP.
02300 JRST LDL ;BACK TO MAIN LOOP.
02400
02500 LDRST: HALT ;THE FEATURE YOU HAVE REQUESTED ...
02600
02700
00100 DARR: PUSH P,[0] ;DEFINE SOME ARRAYS.
00200 DARR1: PUSHJ P,GETNAM ;SCAN NAME.
00300 XWD DF,SWVBT ;TYPE PARAMETER TO GETNAM.
00400 PUSH P,A ;STACK PTR. TO ENTRY.
00500 PUSHJ P,SCAN ;LOOK FOR COMMA.
00600 CAMN A,COMMAV ;IS IT ONE ?
00700 JRST DARR1 ;YES. GET MORE NAMES.
00800 CAME A,LPARV ;NO. SHOULD BE A (.
00900 ERROR(MISSING LEFT PAREN.)
01000 PUSHJ P,SCAN ;GET THE DIMENSION.
01100 TLNN A,NUMFLG ;MAKE SURE IT'S A NUMBER.
01200 ERROR(IMPROPER DIMENSION)
01300 MOVE B,(A) ;GET VALUE.
01400 TLNN A,FIXFLG ;IS IT FLOATING ?
01500 FIX B,233000
01600 ;***********↑↑↑↑↑↑↑
01700 DARR3: AOS JOBFF ;GET FREE STORAGE PTR.
01800 POP P,T ;PTR. TO NAME IN TABLE...
01900 JUMPE T,DARR2 ;UNLESS ITS THE MARK.
02000 JUMPG T,DARR4 ;WAS IT PREVIOUSLY DEFINED ?
02100 HRRZ T1,(T) ;YES. GET ITS BASE ADDRESS.
02200 CAMG B,-1(T1) ;IS NEW DIMENSION > OLD ?
02300 JRST DARR3 ;NO. LEAVE OLD DEFINITION ALONE.
02400 DARR4: AOS A,JOBFF ;INCREMENT FREE STG. PTR. AGAIN.
02500 HRRM A,(T) ;PUT IN SYM. TABLE.
02600 MOVEM B,-1(A) ;PUT DIMENSION IN -1TH ELEMENT.
02700 HRLI A,INSXR ;PUT GOOD INDEX FIELD IN A...
02800 MOVEM A,-2(A) ;PUT PTR. TO ARRAY WITH INDEX IN AR[-2]
02900 ADDM B,JOBFF ;INCREMENT IT.
03000 JRST DARR3 ;TRY FOR ANOTHER.
03100 DARR2: PUSHJ P,SCAN ;GET THE ).
03200 CAME A,RPARV
03300 ERROR(MISSING RIGHT PAREN.)
03400 PUSHJ P,SCAN
03500 CAMN A,COMMAV ;A COMMA ?
03600 JRST DARR ;YES. START OVER AGAIN.
03700 HRRZ JOBSYM ;LET'S FIND OUT IF WE'VE LOST...
03800 CAMG JOBFF ;IS TOP STILL ABOVE BOTTOM ?
03900 ERROR(STORAGE IS FULL)
04000 HRRZ JOBFF
04100 HRLM JOBSA
04200 JRST STATL1
00100 ; HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.
00200
00300 CHOWN1: PUSHJ P,INTER1 ;INTERPRET STATEMENT.
00400 SCHOWN: PUSHJ P,SMSC1 ;GET FIRST NON-SEMICOLON.
00500 CHOWN: CAMN A,PLAYV ;IS IT A 'PLAY' SECTION ?
00600 JRST PLAY1 ;YES.
00700 CAMN A,ALTV ;IS IT AN ALT MODE ?
00800 JRST COMMND ;YES. A COMMAND FOLLOWS.
00900 CAME A, COMPV ;A 'COMPILE' SECTION ?
01000 JRST CHOWN1 ;NO. JUST A STATEMENT.
01100 PUSHJ P,SCOMP ;INIT. THE COMPILER.
01200 PUSHJ P,SSTATL ;COMPILE A STATEMENT LIST.
01300 PUSHJ P,LOADER ;LOAD THE CODE.
01400 JRST SCHOWN ;DONE WITH THAT SECTION.
01500
01600 PLAY1: PUSHJ P,GSBUF ;WE'RE GOING TO PLAY; GET SAMPLE BUFFER.
01700 AOS SBCNT
01800 PLAY1A: SETZM TIME# ;T←0.
01900 SETZM RQPTR# ;RUN QUEUE IS EMPTY.
02000 SETZM MAXSMP# ;INIT. THE MAXIMUM SAMPLE REMEMBERER.
02100 PLAY2: PUSHJ P,SMSC1 ;SCAN A NON-SEMICOLON.
02200 CAME A,FINV ;A 'FINISH ' ?
02300 CAMN A,PLAYV ;... OR A 'PLAY' ?
02400 JRST PTERM ;YES. END OF SECTION.
02500 TLNE A,INSBIT ;AN INSTRUMENT NAME ?
02600 JRST PINS ;YES. A NOTE STATEMENT.
02700 PUSH P,[EXP PLAY2] ;NO. INTERPRET THE STATEMENT.
02800 INTER1: CAME A,INSV
02900 CAMN A,FUNV
03000 ERROR (ILLEGAL 'PLAY' STATEMENT)
03100 PUSHJ P,SCOMPA ;IT MUST BE A RANDOM STATEMENT.
03200 ;PREPARE TO INTERPRET IT BY INITIALIZING
03300 ;THE COMPILER.
03400 PUSHJ P,STAT ;COMPILE THE STATEMENT.
03500
03600 INTERP: MOVE A,[JRST INTER2] ;PREPARE TO EXECUTE TEMPORARY
03700 MOVEI B,0 ;CODE (I.E,RUN IN INTERPRET MODE).
03800 PUSHJ P,EMICDI ;EMIT RETURN INSTR. AT END OF CODE.
03900 PUSHJ P,ENDP1 ;CLEAN UP COMPILER.
04000 PUSH P,JOBFF ;SAVE FREE STG. PTR.
04100 PUSHJ P,LOADER ;LOAD THE TEMPORARY CODE.
04200 MOVEM P,PSV1# ;SAVE IT.
04300 MOVEM FL,FLSV1#
04400 MOVE 17,P ;PTR. FOR (UGH! BLETCH!) FOOTRAN PGMS.
04500 JRST @(P) ;EXECUTE IT.
04600 INTER2: MOVE P,PSV1 ;RESTORE PUSHDOWN POINTER.
04700 MOVE FL,FLSV1
04800 POP P,0 ;RETRIEVE OLD STG. PTR.
04900 HRRZM JOBFF ;FLUSH THE TEMP. CODE.
05000 HRLM JOBSA ;(IT HAS TO GO HERE TOO.)
05100 POPJ P, ;LOOK, MA, I'M AN INTERPRETER !!
05200
00100 ;THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
00200 ; INSTRUMENT, AND GETS IT TURNED ON AT THE RIGHT TIME.
00300
00400 PINS: MOVE A,(A) ;GET STARTING ADDRESSES FOR INSTRUMENT.
00500 PUSH P,(A) ;SAVE THEM.
00600 MOVEI PBASE ;PREPARE TO FILL THE P ARRAY WITH
00700 MOVEM PPTR1# ;THE PARAMETERS TO THE INSTR.
00800 PUSHJ P,SCOMPA ;INIT. COMPLR. FOR POSSIBLE EXPRESSIONS.
00900 MOVE NCHNS ;GET NO. OF OUTPUT CHANNELS.
01000 TLNE -1 ;IS IT FLOATING ?
01100 FIX 233000
01200 ;**********↑↑↑↑↑↑↑↑↑
01300 PINS2: MOVEM NCHNS
01400 PUSH P,NUMBUC ;SAVE CURRENT STATE OF NUMBER
01500 PUSH P,JOBFF ;BUCKET AND CORE TOP.
01600 JRST PINSL ;INIT. THE COMPILER.
01700
01800
01900 PINSL1: CAMN A,COMMAV ;OPTIONAL COMMA BETWEEN PARAMS...
02000 PINSL: PUSHJ P,SCAN
02100 AOS PPTR1 ;INCREMENT P-ARRAY POINTER.
02200 CAMN A,COMMAV ;A COMMA HERE MEANS MISSING
02300 JRST PINSL ;PARAM., SO DON'T CHANGE.
02400 CAMN A,SEMICV ;SEMICOLON ?
02500 JRST PINSB ;YES, END OF PARAMETERS.
02600 PUSHJ P,EXPR ;PARAMETER MAY BE EXPRESSION.
02700 PUSHJ P,GPONDER ;GET OPERAND POINTER FOR THE EXPR...
02800 TLNE T,SIACBT ;IS VALUE OF EXPR AN AC SYMBOL ?
02900 JRST PINS1 ;YES. IT HAS TO BE CALCULATED.
03000 MOVE C,(T) ;PICK UP ITS VALUE.
03100 MOVEM C,@PPTR1 ; SO PUT ITS VALUE IN P-ARRAY NOW.
03200 JRST PINSL1
03300 PINS1: PUSH P,A ;EXPR. GENERATED SOME CODE, EVIDENTLY.
03400 MOVE A,T ;EMIT AN INSTRUCTION TO STORE THE
03500 MOVE B,PPTR1 ;RESULTANT VALUE IN THE P-ARRAY.
03600 MOVE C,[MOVEM EMICDI]
03700 PUSHJ P,EMINST ;THE CODE WILL GET EXECUTED
03800 PUSHJ P,INTERP ; RIGHT NOW.
03900 PUSHJ P,SCOMPA
04000 POP P,A
04100 JRST PINSL1 ;BACK FOR MORE PARAMS.
00100 ;; MORE OF PINS.
00200
00300 PINSB: POP OSP,JOBSYM ;FLUSH COMPLR. OUTPUT BUFFERS.
00400 POP P,0 ;RECOVER OLD CORE TOP.
00500 MOVEM JOBFF ;RESET THINGS TO FORGET
00600 HRLM JOBSA ;ABOUT THE NUMBERS WE DEFINED WHILE
00700 POP P,NUMBUC ;SCANNING NOTE PARAMETERS.
00800 MOVE A,SRATE ;GET NO. OF SAMPLES/SEC.
00900 FDVR A,TIMESC ;DIVIDE BY BEATS/SEC.
01000 MOVE B,PBASE+1 ;GET STARTING TIME FOR NOTE.
01100 FMPR B,A ;CONVERT TO SAMPLES.
01200 FADR B,[0.5]
01300 FIX B,233000
01400 ;***********↑↑↑↑↑↑↑↑↑
01500 MOVEM B,RQ1 ;PLACE AT BOTTOM OF RUN QUEUE.
01600 FMPR A,PBASE+2 ;GET DURATION OF NOTE IN SAMPLES.
01700 FADR A,[0.5]
01800 FIX A,233000
01900 ;***********↑↑↑↑↑↑↑↑↑
02000 ADD A,B ;CALC. ENDING TIME OF NOTE.
02100 PUSH P,A ;SAVE SAME.
02200 PUSHJ P,PLAYIT ;PLAY UP TO STARTING TIME OF NOTE.
02300 PLYON: AOS A,RQPTR ;NOW TURN INSTRUMENT ON.
02400 POP P,RQ1(A) ;PUT ENDING TIME IN RUNQUEUE, COL. ONE.
02500 POP P,T ;GET STARTING ADDR. OF INSTRUMENT.
02600 HLRZM T,RQ2(A) ;PLACE IN RUN QUEUE, COL. TWO.
02700 PUSHJ P,(T) ;EXECUTE THE I-TIME CODE.
02800 JRST PLAY2 ;BACK FOR MORE NOTE STATEMENTS.
02900
03000 PTERM: PUSH P,A ;HERE AT A 'PLAY' OR 'FINISH'.
03100 MOVSI 200000
03200 MOVEM RQ1 ;SET UP FAKE STARTING TIME.
03300 PUSHJ P,PLAYIT ;FLUSH THE RUN QUEUE.
03400 POP P,A
03500 CAMN A,PLAYV ;WAS IT A 'PLAY' THAT WE SAW ?
03600 JRST PLAY1A ;YES. START NEW SECTION.
03700 PUSHJ P,OSBUF ;NO, A 'FINISH'. EMPTY THE
03800 JRST SCHOWN ;SAMPLE BUFFER AND START OVER.
00100 ;; THIS ROUTINE GENERATES SAMPLES BY CALLING THE
00200 ;; INSTRUMENTS IN THE RUN QUEUE UNTIL IT IS TIME
00300 ;; TO TURN ON THE INSTRUMENT WHOSE STARTING TIME IS
00400 ;; IN THE ZEROTH LOCATION OF THE QUEUE, WHEN IT RETURNS.
00500 ;; INSTRUMENTS ARE TURNED OFF AS REQUIRED.
00600
00700 PLAYIT: MOVE A,RQPTR ;SEARCH FOR EARLIEST TIME IN QUEUE.
00800 PLYT2: MOVEM A,PTMP# ;SAVE ITS LOCATION.
00900 SKIPA H,RQ1(A) ;PICK IT UP.
01000 CAMG H,RQ1(A) ;A NEW MINIMUM ?
01100 SOJGE A,.-1 ;NO.
01200 JUMPGE A,PLYT2 ;YES.
01300 PLYT1: CAMN H,[XWD 200000,0] ;MIN. FOUND. IS IT THE TERMINATION
01400 POPJ P, ; MARK ? IF YES, THEN RETURN.
01500 SUB H,TIME ;IT'S NOT . CALC. DISTANCE IN FUTURE.
01600 JUMPLE H,PLYT3 ;IF NOT IN FUTURE, FORGET IT.
01700 ADDM H,TIME ;MOVE TIME TO NEW VALUE.
01800 PLYT4: SKIPE OSP,RQPTR ;CYCLE THRU RUNNING INSTRS., IF ANY.
01900 PUSHJ P,@RQ2(OSP) ;CALL AN INSTR.
02000 SOJG OSP,.-1 ;CALL THEM ALL.
02100 MOVEI F,1 ;START WITH CHANNEL 1.
02200 PLYT5: SOSG SBCNT ;COUNT SAMPLE BUFFER COUNTER.
02300 PUSHJ P,FSBUF ;FLUSH FULL BUFFER.
02400 MOVEI B,0 ;PICK UP NEXT CHANNEL'S SAMPLE, AND
02500 EXCH B,OUTA-1(F) ; ZERO THE LOCATION.
02600 FAD B,[0.5] ;ROUND TO NEAREST INTEGER.
02700 FIX B,233000 ;A. KOTOK SHOULD HAVE DONE THIS.
02800 ;************↑↑↑↑↑↑↑↑
02900 MOVM A,B ;GET MAGNITUDE...
03000 CAMLE A,MAXSMP ;IS THIS SAMPLE THE BIGGEST YET ?
03100 MOVEM A,MAXSMP ;YUP.
03200 IDPB B,SBPTR ;PLACE IT IN SAMPLE BUFFER.
03300 CAMGE F,NCHNS ;LAST CHANNEL ?
03400 AOJA F,PLYT5 ;NO. GET OTHER CHANNELS.
03500 SOJG H,PLYT4 ;GENERATE REST OF SAMPLES.
03600
03700 PLYT3: SKIPG A,PTMP ;GET PTR. TO NEXT INSTR. OFF OR ON.
03800 POPJ P, ;TIME TO TURN ONE ON.
03900 SOS B,RQPTR ;REMOVE INSTR. FROM QUEUE.
04000 MOVE RQ1+1(B) ;MOVE TOP ENTRY DOWN INTO VACANT
04100 MOVEM RQ1(A) ;SPOT.
04200 MOVE RQ2+1(B)
04300 MOVEM RQ2(A)
04400 JRST PLAYIT ;GO PLAY TILL NEXT EVENT.
04500
00100 ;; RANDOM ROUTINES TO HANDLE THE SAMPLE OUTPUT BUFFER.
00200
00300 GSBUF: HRRZ T,JOBSYM ;GET A SAMPLE BUFFER.
00400 SUB T,JOBFF ;HOW MUCH ROOM IS LEFT ?
00500 SUBI T,4*LOBUFS ;(ALLOWING ROOM FOR CODE BUFFERS)
00600 ; SKIPN BIGBIT ;SETS LSBUF TO 1024 IF EITHER BIGBIT OR RCDFLG!
00700 SKIPN RCDFLG
00800 ; SKIPA
00900 JRST GSBUF1 ;1023 IS FOR DEFERRED LONGPLAY
01000 CAIGE T,=1024 ;1024 IS FOR IMMEDIATE LONGPLAY WITH 'PLAY'
01100 ERROR (ADD 1K OF CORE!)
01200 ; MOVEI T,=1023
01300 ; SKIPGE RCDFLG ;IS IT POSITIVE OR ZERO?
01400 MOVEI T,=1024 ;NO, RCDFLG←-1; IS FOR IMMEDIATE LONGPLAY
01500 GSBUF1: MOVEM T,LSBUF ;PUT AWAY.
01600 MOVNS T
01700 PUSHJ P,GFS ;GRAB ENOUGH FREE STORAGE...
01800 HRRZM T,SBBOTT# ;SAVE PTR. TO BUFFER.
01900 FSBUF2: HRLI T,441400 ;MAKE BYTE POINTER.
02000 ; SKIPE BIGBIT ;IS IT 18 BIT?
02100 ; HRLI T,442200 ;YES. RESET BYTE SIZE
02200 MOVEM T,SBPTR# ;
02300 MOVE T,LSBUF ;GET LENGTH OF BUFFER.
02400 ASH T,1 ;SAMPLE CT = LSBUF *2 FOR 18 BIT
02500 ; SKIPN BIGBIT ;IS IT 18 BIT?
02600 ADD T,LSBUF ;NO, MAKE * 3.
02700 MOVEM T,SBCNT#
02800 POPJ P,
02900
03000 OSBUF: HRRZ LSBUF ;THROW OUT SAMPLE BUFFER...
03100 ADDM JOBSYM
03200 MOVEI 0
03300 SKIPA T,SBCNT
03400 IDPB 0,SBPTR
03500 SOJG T,.-1
03600 JRST FSBUF
03700
03800 SMPOUT: MOVE SBBOTT
03900 MOVEM IBOTT
04000 ; MAR 16,71 MOVE BIGBIT
04100 ; MAR 16,71 MOVEM IBIT#
04200 JSA 16, SMPLS ;CALL WRITING ROUTINE
04300 JUMP LSBUF
04400 JUMP SBCNT
04500 IBOTT: 0
04600 JUMP MAXSMP
04700 ; MAR 16,71 JUMP IBIT
04800 JUMP RCDFLG
04900 JUMP RCDFLG ;RCDFLG←-1 WRITES ONE LONG .DMD FILE 6/71
05000 ;; SKIPN BIGBIT
05100 SKIPE RCDFLG ;RCDFLG ON?
05200 ; SKIPE DOPLAY ;PLAY ANYWAY?
05300 JRST FSBUF1 ;GO TO PLAY
05400 JRST FSBF2A ;DOESN'T PLAY
05500
05600
05700 ;FSBUF: SKIPN BIGBIT
05800 FSBUF: SKIPE RCDFLG# ;OUTPUT TO DISC?
05900 JRST SMPOUT
06000 FSBUF1: HRR SBBOTT ;CALCULATE NEGATIVE WORD COUNT.
06100 SUB SBPTR
06200 SUBI 1 ;PREVENT 0 WORD COUNTS.
06300 HRRZ T,SBBOTT ;GET BOTTOM OF BUFFER....
06400 HRLI -1(T) ; MINUS ONE.
06500 MOVSM OUTWC ;PUT IOWD IN RIGHT PLACE.
06600 ;*** SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *******************
06700 PUSHJ P,FSBF1
06800 JRST FSBF2
06900 ;FSBF1: MOVE NCHNS ;NO. OF OUTPUT CHANNELS.
07000 ; TLNE -1
07100 ; FIX 233000
07200 ;**************↑↑↑↑↑↑↑
07300 ;FSBF3: SUBI 1
07350 FSBF1: SETO ;1 CHAN. ONLY IN THIS VERSION!
07400 DPB [POINT 2,OUTBIT,26] ;STEREO OR MONO MODE.
07500 MOVM SPEED
07600 TLNE -1 ;FIX IF NECESSARY.
07700 FIX 233000
07800 ;*********↑↑↑↑↑↑↑↑↑
07900 FSBF4: DPB [POINT 3,OUTBIT,32]
08000 L1: INIT ADCHN,17
08100 SIXBIT /AD/
08200 0
08300 ERROR (A-D UNAVAILABLE.)
08400 POPJ P,
08500
08600 XGP: MOVSI 'XGP' ;TO AVOID XGP CONFILICT
08700 DEVUSE 0,
08800 HLRZ 0,0
08900 CAIN 400000
09000 POPJ P,
09100 INIT 16,17
09200 SIXBIT .XGP.
09300 0
09400 JRST XGP ;was JRA 16,2(16)
09500 POPJ P,
09600 FSBF2: PUSHJ P,XGP ;GO INIT THE XGP
09700 OUTPUT ADCHN,OUTWC ;EMPTY THE BUFFER.
09800 RELEAS ADCHN,
09900 RELEASE 16,
10000 FSBF2A: MOVE T,SBBOTT ;NOW SET UP POINTERS AGAIN.
10100 JRST FSBUF2
10200
10300 OUTWC: 0
10400 3650 ;MAGIC BITS FOR 136.
10500 OUTBIT: 4000 ;BITS FOR A-D.
10600 BLOCK 2
00100 ;; ERROR HANDLING(?) ROUTINES.
00200
00300 ERR1: 0 ;HERE FROM UUO TRAP.
00400 TLNE FL,ERRFLG ;IN ERROR SKIPPING MODE ?
00500 JRST 2,@ERR1 ;YES.
00600 MOVEM 17,ERSVAC+17 ;NO. SAVE ACS.
00700 MOVEI 17,ERSVAC
00800 BLT 17,ERSVAC+16
00900 JSR ERR2 ;PRINT MESSAGE.
01000 MOVSI 17,ERSVAC ;RESTORE AC'S.
01100 BLT 17,17
01200 ERRX: TLO FL,ERRFLG ;ENTER ERROR-SKIPPING MODE.
01300 RELEAS TTY,0
01400 RELEAS DT,0
01500 PUSHJ P,SETUP1
01600 JRST GOB
01700 JRST 2,@ERR1 ;TRY TO CONTINUE (HO, HO.).
01800
01900 ERSVAC: BLOCK 20
02000
02100 ERR2: 0 ;ERROR MESSAGE PRINTER.
02200 HRRZI [ASCIZ /
02300 $$$ ERROR: /]
02400 JSR TXTOUT
02500 HRRZ 40
02600 JSR TXTOUT
02700 HRRZI [ASCIZ /
02800 /]
02900 JSR TXTOUT
03000 MOVE A,ISCP
03100 MOVE B,A
03200 MOVE C,B
03300 ERR2B: ILDB A
03400 CAIE 15
03500 JRST ERR2A
03600 MOVE C,B
03700 MOVE B,A
03800 ERR2A: CAME A,SCP
03900 JRST ERR2B
04000 JRST ERR2D
04100 ERR2C: SOSGE TOB+2
04200 OUTPUT TTY,0
04300 IDPB TOB+1
04400 ERR2D: ILDB C
04500 CAME C,SCP
04600 JRST ERR2C
04700 SKIPN SNCHR
04800 IDPB TOB+1
04900 OUTPUT TTY,0
05000 JRST @ERR2
05100
05200
00100
00200 SYMSCH: MOVEI T,6 ;LOOK UP EXTERNAL SYMBOL.
00300 MOVE [POINT 6,ACCUM,5] ;PREPARE TO CONVERT TO
00400 MOVEI B,0
00500 SYMS1: ILDB A,0 ;RADIX 50.
00600 JUMPE A,SYMS4
00700 CAIN A,16
00800 MOVEI A,73
00900 CAIG A,5
01000 ADDI A,70
01100 CAIGE A,32
01200 ADDI A,7
01300 IMULI B,50
01400 ADDI B,-26(A)
01500 SOJG T,SYMS1
01600 SYMS4: TLO B,40000
01700 MOVE A,116
01800 SYMS3: AOBJP A,SYMS2
01900 CAME B,-1(A)
02000 AOBJN A,SYMS3
02100 SYMS2: SKIPL A
02200 SKIPA A,[EXP NX]
02300 HRRZ A,(A)
02400 POPJ P,
02500
02600 NX: 0
02700 ERROR (MISSING EXTERNAL FUNCTION)
02800 JRST INTER2
02900
03000
03100 INTERNAL RDNUM,MESS,PNUM
03200
03300 EXTERNAL JOBDDT;
03400 PNUM: 0
03500 MOVE P,JOBFF
03600 SKIPGE A,@(RA)
03700 OUTCHR ["-"]
03800 MOVMS A
03900 PUSHJ P,DECPNT
04000 OUTPUT TTY,0
04100 JRA RA,1(RA)
00100 RDNUM: 0 ;NUMBER READER FOR FOOTRAN ROUTINES.
00200 MOVE P,JOBFF ;GET TEMP. PDL
00300 EXCH FL,FLSV1
00400 RDNUM1: TLO FL,SNUMF1
00500 PUSHJ P,SCAN
00600 CAMN A,MINV ;A MINUS SIGN ?
00700 TLOA FL,MINFLG ;YES. SET FLAG AND LOOP BACK.
00800 TLNN A,NUMFLG ;IT IS A NUMBER, ISN'T IT ?
00900 JRST RDNUM1 ;NO. IGNORE IT.
01000 TLZE FL,MINFLG ;YES. HAVE WE SEEN A MINUS LATELY ?
01100 MOVNS C ;YES.
01200 MOVEM C,@(RA) ;PUT VALUE INTO PARAMETER.
01300 EXCH FL,FLSV1
01400 JRA RA,1(RA) ;RETURN TO (UGH ! BLETCH !) FOOTRAN.
01500 MESS: 0 ;MESSAGE PRINTER FOR FOOTRAN ROUTINES.
01600 HRRZ (RA) ;GET LOC. OF MESSAGE.
01700 CALLI 3
01800 JRA RA,1(RA)
01900
02000 FOOPRT: 0
02100 MOVM A,@(RA)
02200 TLNE A,777000
02300 FIX A,233000
02400 ;**********↑↑↑↑↑↑↑↑↑↑↑
02500 PUSHJ P,DECPNT
02600 OUTPUT TTY,0
02700 JRST 1(RA)
02800
02900 COMMND: MOVEI [ASCII /$/]
03000 CALLI 3
03100 PUSHJ P,SCANNS ;GET COMMAND.
03200 JUMPL A,COMND1
03300 MOVE ACCUM
03400 MOVE 1,ACCUM+1
03500 LSHC 6
03600 CAMN [SIXBIT /RESET/]
03700 JRST REST1
03800 CAMN [SIXBIT /PRINT/]
03900 JRST CPNT ;A 'PRINT' COMMAND.
04000 CAMN [SIXBIT /P/]
04100 JRST CPLX
04200 CAMN [SIXBIT /DDT/]
04300 JRST @JOBDDT
04400 COMND1: MOVEI [ASCIZ /?? /]
04500 CALLI 3
04600 JRST SCHOWN
04700 CPLX: PUSHJ P,CGNUM ;GET FOLLOWING NUMBER, IF ANY.
04800 MOVEI T,1 ;NO NUMBER. TAKE AS 1.
04900 CPLAY:
05000 ; SKIPE DSKFLG ;DISK OUTPUT ?
05100 ; JRST DSKPLA ;YES.
05200 ;********* SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *********
05300 PUSHJ P,FSBF1 ;SET UP FOR D-A OUTPUT.
05400 PUSHJ P,XGP
05500 OUTPUT ADCHN,OUTWC
05600 SOJG T,CPLAY ;REPEAT AS INDICATED BY ARGUMENT.
05700 RELEAS ADCHN,
05800 RELEASE 16,
05900 JRST SCHOWN
06000
00100 REST1: MOVEI TEMPSY
00200 MOVEM BUCTBL
00300 JRST GO
00400
00500 ;MORE COMMAND ROUTINES.
00600
00700 CPNT: PUSHJ P,SCOMPA ;INIT. THE COMPILER.
00800 PUSH OSP,[XWD VRBLBT,[XWD VRBLBT,CPNTX#]] ;PUT FAKE VARIABLE IN STACK.
00900 PUSHJ P,ASTMT1 ;COMPILE RIGHT PART OF AN ASSIGNENT STATEMENT.
01000 PUSHJ P,INTERP ;EXECUTE THE CODE.
01100 ;***** SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *****************
01200 MOVM A,CPNTX ;GET ITS VALUE.
01300 TLNE A,377000 ;ASSUMING ITS >0, IS IT FLOATING?
01400 FIX A,233000
01500 ;***********↑↑↑↑↑↑↑↑↑
01600 CPNT2: PUSHJ P,DECPNT ;PRINT IT.
01700 OUTPUT TTY,0
01800 POP P,A ;GET THING WHICH TERMINATED EXPR. (LEFT ON STACK BY ASTMT1).
01900 CAMN A,SEMICV ;A SEMICOLON ?
02000 JRST SCHOWN ;YES. FORGET IT.
02100 JRST CHOWN ;NO. LOOK AT IT.
02200
02300
02400 CGNUM: TLO FL,SNUMF1 ;DONT PUT NO.'S IN TABLE.
02500 PUSHJ P,SCAN ;LOOK FOR (OPTIONAL) NUMERIC ARGUMENT.
02600 TLNN A,NUMFLG ;IS THERE ONE ?
02700 POPJ P, ;NO.
02800 MOVE T,C ;YES. GET VALUE.
02900 TLNN A,FIXFLG ;IS IT FLOATING ?
03000 FIX T,233000 ;NOT ANY MORE.
03100 ;*********↑↑↑↑↑↑↑↑↑↑↑
03200 CGNUM2: POP P,T1 ;GET RETURN ADDR.
03300 JRST 1(T1) ;SKIP ON RETURN.
03400 END GO